├── .gitignore ├── Changes.pod ├── LICENSE ├── MANIFEST ├── Makefile.PL ├── README.pod ├── clients └── vscode │ └── perl │ ├── .gitignore │ ├── .vscode │ ├── extensions.json │ ├── launch.json │ ├── settings.json │ └── tasks.json │ ├── .vscodeignore │ ├── CHANGELOG.md │ ├── LICENSE │ ├── README.md │ ├── out │ └── dbgforward.js │ ├── package-lock.json │ ├── package.json │ ├── src │ └── extension.ts │ ├── tsconfig.json │ └── tslint.json ├── debian ├── changelog ├── control ├── copyright └── rules ├── docs └── Perl-LanguageServer und Debugger für Visual Studio Code u.a. Editoren - Perl Workshop 2020.pdf ├── lib └── Perl │ ├── LanguageServer.pm │ └── LanguageServer │ ├── DebuggerBridge.pm │ ├── DebuggerInterface.pm │ ├── DebuggerProcess.pm │ ├── DevTool.pm │ ├── IO.pm │ ├── Methods.pm │ ├── Methods │ ├── DebugAdapter.pm │ ├── DebugAdapterInterface.pm │ ├── textDocument.pm │ └── workspace.pm │ ├── Parser.pm │ ├── Req.pm │ ├── SyntaxChecker.pm │ └── Workspace.pm └── t ├── 00-load.t ├── manifest.t ├── pod-coverage.t └── pod.t /.gitignore: -------------------------------------------------------------------------------- 1 | Makefile 2 | Makefile.old 3 | Build 4 | Build.bat 5 | META.* 6 | MYMETA.* 7 | .build/ 8 | _build/ 9 | cover_db/ 10 | blib/ 11 | inc/ 12 | .lwpcookies 13 | .last_cover_stats 14 | nytprof.out 15 | pod2htm*.tmp 16 | pm_to_blib 17 | Perl-LanguageServer-* 18 | Perl-LanguageServer-*.tar.gz 19 | scripts/ 20 | /.vscode 21 | p5-Compiler-Lexer 22 | Perl-LanguageServer.code-workspace 23 | debian/.debhelper 24 | debian/libperl-languageserver-perl 25 | debian/debhelper-build-stamp 26 | debian/files 27 | debian/libperl-languageserver-perl.substvars 28 | .kube/ 29 | docs/TODO 30 | -------------------------------------------------------------------------------- /Changes.pod: -------------------------------------------------------------------------------- 1 | =head1 Change Log 2 | 3 | =head2 2.6.2 C<2023-12-23> 4 | 5 | =over 6 | 7 | =item * avoid given/when/smartmatch because these features are deprecated in perl 5.38 (#199) [real-dam] 8 | 9 | =back 10 | 11 | =head2 2.6.1 C<2023-07-26> 12 | 13 | =over 14 | 15 | =item * Fix: Formatting with perltidy was broken in 2.6.0 16 | 17 | =back 18 | 19 | =head2 2.6.0 C<2023-07-23> 20 | 21 | =over 22 | 23 | =item * Add debug setting for running as different user. See sudoUser setting. (#174) [wielandp] 24 | 25 | =item * Allow to use a string for debuggee arguments. (#149, #173) [wielandp] 26 | 27 | =item * Add stdin redirection (#166) [wielandp] 28 | 29 | =item * Add link to issues to META files (#168) [szabgab/issues] 30 | 31 | =item * Add support for podman 32 | 33 | =item * Add support for run Perl::LanguageServer outside, but debugger inside a container 34 | 35 | =item * Add setting useTaintForSyntaxCheck. If true, use taint mode for syntax check (#172) [wielandp] 36 | 37 | =item * Add setting useTaintForDebug. If true, use taint mode inside debugger (#181) [wielandp] 38 | 39 | =item * Add debug adapter request C, which allows to display source of eval or file that are not available to vscode (#180) [wielandp] 40 | 41 | =item * Fix: Spelling (#170, #171) [pkg-perl-tools] 42 | 43 | =item * Fix: Convert charset encoding of debugger output according to current locale (#167) [wielandp] 44 | 45 | =item * Fix: Fix diagnostic notifications override on clients (based on #185) [bmeneg] 46 | 47 | =back 48 | 49 | =head2 2.5.0 C<2023-02-05> 50 | 51 | =over 52 | 53 | =item * Set minimal Perl version to 5.16 (#91) 54 | 55 | =item * Per default environment from vscode will be passed to debuggee, syntax check and perltidy. 56 | 57 | =item * Add configuration C to not pass environment variables. 58 | 59 | =item * Support for C and C settings via LanguageServer protocol and 60 | not only via command line options (#97) [schellj] 61 | 62 | =item * Fix: "No DB::DB routine defined" (#91) [peterdragon] 63 | 64 | =item * Fix: Typos and spelling in README (#159) [dseynhae] 65 | 66 | =item * Fix: Update call to gensym(), to fix 'strict subs' error (#164) [KohaAloha] 67 | 68 | =item * Convert identention from tabs to spaces and remove trailing whitespaces 69 | 70 | =back 71 | 72 | =head2 2.4.0 C<2022-11-18> 73 | 74 | =over 75 | 76 | =item * Choose a different port for debugAdapterPort if it is already in use. This 77 | avoids trouble with starting C if another instance 78 | of C is running on the same machine (thanks to hakonhagland) 79 | 80 | =item * Add configuration C, for choosing range of port for dynamic 81 | port assignment 82 | 83 | =item * Add support for using LanguageServer and debugger inside a Container. 84 | Currently docker containers und containers running inside kubernetes are supported. 85 | 86 | =item * When starting debugger session and C is false, do not switch to sourefile 87 | where debugger would stop, when C is true. 88 | 89 | =item * Added some FAQs in README 90 | 91 | =item * Fix: Debugger stopps at random locations 92 | 93 | =item * Fix: debugAdapterPort is now numeric 94 | 95 | =item * Fix: debugging loop with each statement (#107) 96 | 97 | =item * Fix: display of arrays in variables pane on mac (#120) 98 | 99 | =item * Fix: encoding for C (#127) 100 | 101 | =item * Fix: return error if C fails, so text is not removed by failing 102 | formatting request (#87) 103 | 104 | =item * Fix: FindBin does not work when checking syntax (#16) 105 | 106 | =back 107 | 108 | =head2 2.3.0 C<2021-09-26> 109 | 110 | =over 111 | 112 | =item * Arguments section in Variable lists now C<@ARGV> and C<@_> during debugging (#105) 113 | 114 | =item * C<@_> is now correctly evaluated inside of debugger console 115 | 116 | =item * C<$#foo> is now correctly evaluated inside of debugger console 117 | 118 | =item * Default debug configuration is now automatically provided without 119 | the need to create a C first (#103) 120 | 121 | =item * Add Option C to specify location of cache dir (#113) 122 | 123 | =item * Fix: Debugger outputted invalid thread reference causes "no such coroutine" message, 124 | so watchs and code from the debug console is not expanded properly 125 | 126 | =item * Fix: LanguageServer hangs when multiple request send at once from VSCode to LanguageServer 127 | 128 | =item * Fix: cwd parameter for debugger in launch.json had no effect (#99) 129 | 130 | =item * Fix: Correctly handle paths with drive letters on windows 131 | 132 | =item * Fix: sshArgs parameter was not declared as array (#109) 133 | 134 | =item * Disable syntax check on windows, because it blocks the whole process when running on windows, 135 | until handling of child's processes is fixed 136 | 137 | =item * Fixed spelling (#86,#96,#101) [chrstphrchvz,davorg,aluaces] 138 | 139 | =back 140 | 141 | =head2 2.2.0 C<2021-02-21> 142 | 143 | =over 144 | 145 | =item * Parser now supports Moose method modifieres before, after and around, 146 | so they can be used in symbol view and within reference search 147 | 148 | =item * Support Format Document and Format Selection via perltidy 149 | 150 | =item * Add logFile config option 151 | 152 | =item * Add perlArgs config option to pass options to Perl interpreter. Add some documentation for config options. 153 | 154 | =item * Add disableCache config option to make LanguageServer usable with readonly directories. 155 | 156 | =item * updated dependencies package.json & package-lock.json 157 | 158 | =item * Fix deep recursion in SymbolView/Parser which was caused by function prototypes. 159 | Solves also #65 160 | 161 | =item * Fix duplicate req id's that caused cleanup of still 162 | running threads which in turn caused the LanguageServer to hang 163 | 164 | =item * Prevent dereferencing an undefined value (#63) [Heiko Jansen] 165 | 166 | =item * Fix datatype of cwd config options (#47) 167 | 168 | =item * Use perlInc setting also for LanguageServer itself (based only pull request #54 from ALANVF) 169 | 170 | =item * Catch Exceptions during display of variables inside debugger 171 | 172 | =item * Fix detecting duplicate LanguageServer processes 173 | 174 | =item * Fix spelling in documentation (#56) [Christopher Chavez] 175 | 176 | =item * Remove notice about Compiler::Lexer 0.22 bugs (#55) [Christopher Chavez] 177 | 178 | =item * README: Typo and grammar fixes. Add Carton lib path instructions. (#40) [szTheory] 179 | 180 | =item * README: Markdown code block formatting (#42) [szTheory] 181 | 182 | =item * Makefile.PL: add META_MERGE with GitHub info (#32) [Christopher Chavez] 183 | 184 | =item * search.cpan.org retired, replace with metacpan.org (#31) [Christopher Chavez] 185 | 186 | =back 187 | 188 | =head2 2.1.0 C<2020-06-27> 189 | 190 | =over 191 | 192 | =item * Improve Symbol Parser (fix parsing of anonymous subs) 193 | 194 | =item * showLocalSymbols 195 | 196 | =item * function names in breadcrump 197 | 198 | =item * Signature Help for function/method arguments 199 | 200 | =item * Add Presentation on Perl Workshop 2020 to repos 201 | 202 | =item * Remove Compiler::Lexer from distribution since 203 | version is available on CPAN 204 | 205 | =item * Make stdout unbuffered while debugging 206 | 207 | =item * Make debugger use perlInc setting 208 | 209 | =item * Fix fileFilter setting 210 | 211 | =item * Sort Arrays numerically in variables view of debugger 212 | 213 | =item * Use rootUri if workspaceFolders not given 214 | 215 | =item * Fix env config setting 216 | 217 | =item * Recongnice changes in config of perlCmd 218 | 219 | =back 220 | 221 | =head2 2.0.2 C<2020-01-22> 222 | 223 | =over 224 | 225 | =item * Plugin: Fix command line parameters for plink 226 | 227 | =item * Perl::LanguageServer: Fix handling of multiple parallel request, improve symlink handling, add support for UNC paths in path mapping, improve logging for logLevel = 1 228 | 229 | =back 230 | 231 | =head2 2.0.1 C<2020-01-14> 232 | 233 | Added support for reloading Perl module while debugging, make log level configurable, make sure tooltips don't call functions 234 | 235 | =head2 2.0.0 C<2020-01-01> 236 | 237 | Added Perl debugger 238 | 239 | =head2 0.9.0 C<2019-05-03> 240 | 241 | Fix issues in the Perl part, make sure to update Perl::LanguageServer from cpan 242 | 243 | =head2 0.0.3 C<2018-09-08> 244 | 245 | Fix issue with not reading enough from stdin, which caused LanguageServer to hang sometimes 246 | 247 | =head2 0.0.2 C<2018-07-21> 248 | 249 | Fix quitting issue when starting Perl::LanguageServer, more fixes are in the Perl part 250 | 251 | =head2 0.0.1 C<2018-07-13> 252 | 253 | Initial Version 254 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | vscode-extension-perl 2 | 3 | LICENSE AND COPYRIGHT 4 | 5 | Copyright 2018-2022 Gerald Richter. 6 | 7 | This program is free software; you can redistribute it and/or modify it 8 | under the terms of the the Artistic License (2.0). You may obtain a 9 | copy of the full license at: 10 | 11 | L 12 | 13 | Any use, modification, and distribution of the Standard or Modified 14 | Versions is governed by this Artistic License. By using, modifying or 15 | distributing the Package, you accept this license. Do not use, modify, 16 | or distribute the Package, if you do not accept this license. 17 | 18 | If your Modified Version has been derived from a Modified Version made 19 | by someone other than you, you are nevertheless required to ensure that 20 | your Modified Version complies with the requirements of this license. 21 | 22 | This license does not grant you the right to use any trademark, service 23 | mark, tradename, or logo of the Copyright Holder. 24 | 25 | This license includes the non-exclusive, worldwide, free-of-charge 26 | patent license to make, have made, use, offer to sell, sell, import and 27 | otherwise transfer the Package with respect to any patent claims 28 | licensable by the Copyright Holder that are necessarily infringed by the 29 | Package. If you institute patent litigation (including a cross-claim or 30 | counterclaim) against any party alleging that the Package constitutes 31 | direct or contributory patent infringement, then this Artistic License 32 | to you shall terminate on the date that such litigation is filed. 33 | 34 | Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER 35 | AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. 36 | THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR 37 | PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY 38 | YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR 39 | CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR 40 | CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, 41 | EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 42 | 43 | -------------------------------------------------------------------------------- /MANIFEST: -------------------------------------------------------------------------------- 1 | Changes.pod 2 | lib/Perl/LanguageServer.pm 3 | lib/Perl/LanguageServer/DebuggerBridge.pm 4 | lib/Perl/LanguageServer/DebuggerInterface.pm 5 | lib/Perl/LanguageServer/DebuggerProcess.pm 6 | lib/Perl/LanguageServer/DevTool.pm 7 | lib/Perl/LanguageServer/IO.pm 8 | lib/Perl/LanguageServer/Methods.pm 9 | lib/Perl/LanguageServer/Methods/DebugAdapter.pm 10 | lib/Perl/LanguageServer/Methods/DebugAdapterInterface.pm 11 | lib/Perl/LanguageServer/Methods/textDocument.pm 12 | lib/Perl/LanguageServer/Methods/workspace.pm 13 | lib/Perl/LanguageServer/Parser.pm 14 | lib/Perl/LanguageServer/Req.pm 15 | lib/Perl/LanguageServer/SyntaxChecker.pm 16 | lib/Perl/LanguageServer/Workspace.pm 17 | Makefile.PL 18 | MANIFEST This list of files 19 | README.pod 20 | LICENSE 21 | t/00-load.t 22 | 23 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | use v5.16; 2 | use strict; 3 | use warnings; 4 | use ExtUtils::MakeMaker; 5 | use FindBin ; 6 | use File::Basename ; 7 | use Cwd; 8 | 9 | =pod 10 | my $mydir = getcwd; 11 | my $lexer_make = $FindBin::Bin . '/p5-Compiler-Lexer/Build.PL' ; 12 | my $lexer_inst = $FindBin::Bin . '/p5-Compiler-Lexer/Build' ; 13 | if (-e $lexer_make) 14 | { 15 | print "Running $lexer_make to build included Compiler::Lexer\n\n" ; 16 | 17 | my $dir = dirname ($lexer_make) ; 18 | chdir $dir ; 19 | #system ("cd '$dir' && perl '$lexer_make'") and 20 | my $rc ; 21 | if (!($rc = system ('perl', $lexer_make))) 22 | { 23 | print "Install Compiler::Lexer\n\n" ; 24 | $rc = system ($lexer_inst, 'install') ; 25 | } 26 | if ($rc) 27 | { 28 | warn "Cannot run perl Build.PL for Compiler::Lexer. You need to install Compiler::Lexer from Github (do not use version 0.22)" ; 29 | } 30 | chdir $mydir ; 31 | } 32 | =cut 33 | 34 | WriteMakefile( 35 | NAME => 'Perl::LanguageServer', 36 | AUTHOR => q{grichter }, 37 | VERSION_FROM => 'lib/Perl/LanguageServer.pm', 38 | ABSTRACT_FROM => 'lib/Perl/LanguageServer.pm', 39 | LICENSE => 'artistic_2', 40 | META_MERGE => { 41 | 'meta-spec' => { version => 2 }, 42 | resources => { 43 | repository => { 44 | type => 'git', 45 | url => 'https://github.com/richterger/Perl-LanguageServer.git', 46 | web => 'https://github.com/richterger/Perl-LanguageServer', 47 | }, 48 | bugtracker => { 49 | web => 'https://github.com/richterger/Perl-LanguageServer/issues' 50 | }, 51 | }, 52 | }, 53 | PL_FILES => {}, 54 | MIN_PERL_VERSION => '5.016', 55 | CONFIGURE_REQUIRES => { 56 | 'ExtUtils::MakeMaker' => '0', 57 | }, 58 | BUILD_REQUIRES => { 59 | 'Test::More' => '0', 60 | }, 61 | PREREQ_PM => { 62 | 'Moose' => '0', 63 | 'AnyEvent' => '0', 64 | 'IO::AIO' => '0', 65 | 'AnyEvent::AIO' => '0', 66 | 'Coro' => '0', 67 | 'JSON' => '0', 68 | 'Data::Dump' => '0', 69 | 'PadWalker' => '0', 70 | 'Scalar::Util' => '0', 71 | 'Class::Refresh' => '0', 72 | 'Compiler::Lexer' => '0.23', 73 | 'Hash::SafeKeys' => '0', 74 | 'Encode::Locale' => '0', 75 | }, 76 | dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, 77 | clean => { FILES => 'Perl-LanguageServer-*' }, 78 | ); 79 | -------------------------------------------------------------------------------- /README.pod: -------------------------------------------------------------------------------- 1 | =head1 Perl::LanguageServer 2 | 3 | Language Server and Debug Protocol Adapter for Perl 4 | 5 | =head2 Features 6 | 7 | =over 8 | 9 | =item * Language Server 10 | 11 | =over 12 | 13 | =item * Syntax checking 14 | 15 | =item * Symbols in file 16 | 17 | =item * Symbols in workspace/directory 18 | 19 | =item * Goto Definition 20 | 21 | =item * Find References 22 | 23 | =item * Call Signatures 24 | 25 | =item * Supports multiple workspace folders 26 | 27 | =item * Document and selection formatting via perltidy 28 | 29 | =item * Run on remote system via ssh 30 | 31 | =item * Run inside docker container 32 | 33 | =item * Run inside kubernetes 34 | 35 | =back 36 | 37 | =item * Debugger 38 | 39 | =over 40 | 41 | =item * Run, pause, step, next, return 42 | 43 | =item * Support for coro threads 44 | 45 | =item * Breakpoints 46 | 47 | =item * Conditional breakpoints 48 | 49 | =item * Breakpoints can be set while program runs and for modules not yet loaded 50 | 51 | =item * Variable view, can switch to every stack frame or coro thread 52 | 53 | =item * Set variable 54 | 55 | =item * Watch variable 56 | 57 | =item * Tooltips with variable values 58 | 59 | =item * Evaluate perl code in debuggee, in context of every stack frame of coro thread 60 | 61 | =item * Automatically reload changed Perl modules while debugging 62 | 63 | =item * Debug multiple perl programs at once 64 | 65 | =item * Run on remote system via ssh 66 | 67 | =item * Run inside docker container 68 | 69 | =item * Run inside kubernetes 70 | 71 | =back 72 | 73 | =back 74 | 75 | =head2 Requirements 76 | 77 | You need to install the perl module Perl::LanguageServer to make this extension work, 78 | e.g. run C on your target system. 79 | 80 | Please make sure to always run the newest version of Perl::LanguageServer as well. 81 | 82 | NOTE: Perl::LanguageServer depend on AnyEvent::AIO and Coro. There is a warning that 83 | this might not work with newer Perls. It works fine for Perl::LanguageServer. So just 84 | confirm the warning and install it. 85 | 86 | Perl::LanguageServer depends on other Perl modules. It is a good idea to install most 87 | of then with your linux package manager. 88 | 89 | e.g. on Debian/Ubuntu run: 90 | 91 | 92 | 93 | sudo apt install build-essential libanyevent-perl libclass-refresh-perl libcompiler-lexer-perl \ 94 | libdata-dump-perl libio-aio-perl libjson-perl libmoose-perl libpadwalker-perl \ 95 | libscalar-list-utils-perl libcoro-perl 96 | 97 | sudo cpan Perl::LanguageServer 98 | 99 | 100 | e.g. on Centos 7 run: 101 | 102 | 103 | 104 | sudo yum install perl-App-cpanminus perl-AnyEvent-AIO perl-Coro 105 | sudo cpanm Class::Refresh 106 | sudo cpanm Compiler::Lexer 107 | sudo cpanm Hash::SafeKeys 108 | sudo cpanm Perl::LanguageServer 109 | 110 | 111 | In case any of the above packages are not available for your os version, just 112 | leave them out. The cpan command will install missing dependencies. In case 113 | the test fails, when running cpan C, you should try to run C. 114 | 115 | =head2 Extension Settings 116 | 117 | This extension contributes the following settings: 118 | 119 | =over 120 | 121 | =item * C: enable/disable this extension 122 | 123 | =item * C: ip address of remote system 124 | 125 | =item * C: optional, port for ssh to remote system 126 | 127 | =item * C: user for ssh login 128 | 129 | =item * C: defaults to ssh on unix and plink on windows 130 | 131 | =item * C: path of the workspace root on remote system 132 | 133 | =item * C: defaults to perl 134 | 135 | =item * C: additional arguments passed to the perl interpreter that starts the LanguageServer 136 | 137 | =item * C: if true, use taint mode for syntax check 138 | 139 | =item * C: optional arguments for ssh 140 | 141 | =item * C: mapping of local to remote paths 142 | 143 | =item * C: array with paths to add to perl library path. This setting is used by the syntax checker and for the debuggee and also for the LanguageServer itself. 144 | 145 | =item * C: array for filtering perl file, defaults to [I<.pm,>.pl] 146 | 147 | =item * C: directories to ignore, defaults to [.vscode, .git, .svn] 148 | 149 | =item * C: port to use for connection between vscode and debug adapter inside Perl::LanguageServer. 150 | 151 | =item * C: if debugAdapterPort is in use try ports from debugAdapterPort to debugAdapterPort + debugAdapterPortRange. Default 100. 152 | 153 | =item * C: if true, show also local variables in symbol view 154 | 155 | =item * C: Log level 0-2. 156 | 157 | =item * C: If set, log output is written to the given logfile, instead of displaying it in the vscode output pane. Log output is always appended. Only use during debugging of LanguageServer itself. 158 | 159 | =item * C: If true, the LanguageServer will not cache the result of parsing source files on disk, so it can be used within readonly directories 160 | 161 | =item * C: If set Perl::LanguageServer can run inside a container. Options are: 'docker', 'docker-compose', 'kubectl' 162 | 163 | =item * C: arguments for containerCmd. Varies depending on containerCmd. 164 | 165 | =item * C: To start a new container, set to 'run', to execute inside an existing container set to 'exec'. Note: kubectl only supports 'exec' 166 | 167 | =item * C: Image to start or container to exec inside or pod to use 168 | 169 | =back 170 | 171 | =head2 Debugger Settings for launch.json 172 | 173 | =over 174 | 175 | =item * C: needs to be C 176 | 177 | =item * C: only C is supported (this is a restriction of perl itself) 178 | 179 | =item * C: name of this debug configuration 180 | 181 | =item * C: path to perl program to start 182 | 183 | =item * C: if true, program will stop on entry 184 | 185 | =item * C: optional, array or string with arguments for perl program 186 | 187 | =item * C: optional, object with environment settings 188 | 189 | =item * C: optional, change working directory before launching the debuggee 190 | 191 | =item * C: if true, automatically reload changed Perl modules while debugging 192 | 193 | =item * C: optional, if set run debug process with sudo -u \. 194 | 195 | =item * C: optional, if true run debug process with -T (taint mode). 196 | 197 | =item * C: If set debugger runs inside a container. Options are: 'docker', 'docker-compose', 'podman', 'kubectl' 198 | 199 | =item * C: arguments for containerCmd. Varies depending on containerCmd. 200 | 201 | =item * C: To start a new container, set to 'run', to debug inside an existing container set to 'exec'. Note: kubectl only supports 'exec' 202 | 203 | =item * C: Image to start or container to exec inside or pod to use 204 | 205 | =item * C: mapping of local to remote paths for this debug session (overwrites global C) 206 | 207 | =back 208 | 209 | =head2 Remote syntax check & debugging 210 | 211 | If you developing on a remote machine, you can instruct the Perl::LanguageServer to 212 | run on that remote machine, so the correct modules etc. are available for syntax check and debugger is started on the remote machine. 213 | To do so set sshAddr and sshUser, preferably in your workspace configuration. 214 | 215 | Example: 216 | 217 | 218 | "sshAddr": "10.11.12.13", 219 | "sshUser": "root" 220 | 221 | Also set sshWorkspaceRoot, so the local workspace path can be mapped to the remote one. 222 | 223 | Example: if your local path is \10.11.12.13\share\path\to\ws and on the remote machine you have /path/to/ws 224 | 225 | 226 | "sshWorkspaceRoot": "/path/to/ws" 227 | 228 | The other possibility is to provide a pathMap. This allows one to having multiple mappings. 229 | 230 | Examples: 231 | 232 | 233 | "perl.pathMap": [ 234 | ["remote uri", "local uri"], 235 | ["remote uri", "local uri"] 236 | ] 237 | 238 | "perl.pathMap": [ 239 | [ 240 | "file:///", 241 | "file:///home/systems/mountpoint/" 242 | ] 243 | ] 244 | 245 | =head2 Syntax check & debugging inside a container 246 | 247 | You can run the LanguageServer and/or debugger inside 248 | a container by setting C and C. 249 | There are more container options, see above. 250 | 251 | .vscode/settings.json 252 | 253 | 254 | { 255 | "perl": { 256 | "enable": true, 257 | "containerCmd": "docker", 258 | "containerName": "perl_container", 259 | } 260 | } 261 | 262 | This will start the whole Perl::LanguageServer inside the container. This is espacally 263 | helpfull to make syntax check working, if there is a different setup inside 264 | and outside the container. 265 | 266 | In this case you need to tell the Perl::LanguageServer how to map local paths 267 | to paths inside the container. This is done by setting C (see above). 268 | 269 | Example: 270 | 271 | 272 | "perl.pathMap": [ 273 | [ 274 | "file:///path/inside/the/container", 275 | "file:///local/path/outside/the/container" 276 | ] 277 | ] 278 | 279 | It's also possible to run the LanguageServer outside the container and only 280 | the debugger inside the container. This is especially helpfull, when the 281 | container is not always running, while you are editing. 282 | To make only the debugger running inside the container, put 283 | C, C and C in your C. 284 | You can have different setting for each debug session. 285 | 286 | Normaly the arguments for the C are automatically build. In case 287 | you want to use an unsupported C you need to specifiy 288 | apropriate C. 289 | 290 | =head2 FAQ 291 | 292 | =head3 Working directory is not defined 293 | 294 | It is not defined what the current working directory is at the start of a perl program. 295 | So Perl::LanguageServer makes no assumptions about it. To solve the problem you can set 296 | the directory via cwd configuration parameter in launch.json for debugging. 297 | 298 | =head3 Module not found when debugging or during syntax check 299 | 300 | If you reference a module with a relative path or if you assume that the current working directory 301 | is part of the Perl search path, it will not work. 302 | Instead set the perl include path to a fixed absolute path. In your settings.json do something like: 303 | 304 | 305 | "perl.perlInc": [ 306 | "/path/a/lib", 307 | "/path/b/lib", 308 | "/path/c/lib", 309 | ], 310 | Include path works for syntax check and inside of debugger. 311 | C should be an absolute path. 312 | 313 | =head3 AnyEvent, Coro Warning during install 314 | 315 | You need to install the AnyEvent::IO and Coro. Just ignore the warning that it might not work. For Perl::LanguageServer it works fine. 316 | 317 | =head3 'richterger.perl' failed: options.port should be >= 0 and < 65536 318 | 319 | Change port setting from string to integer 320 | 321 | =head3 Error "Can't locate MODULE_NAME" 322 | 323 | Please make sure the path to the module is in C setting and use absolute path names in the perlInc settings 324 | or make sure you are running in the expected directory by setting the C setting in the lauch.json. 325 | 326 | =head3 ERROR: Unknown perlmethod IsetTraceNotification 327 | 328 | This is not an issue, that just means that not all features of the debugging protocol are implemented. 329 | Also it says ERROR, it's just a warning and you can safely ignore it. 330 | 331 | =head3 The debugger sometimes stops at random places 332 | 333 | Upgrade to Version 2.4.0 334 | 335 | =head3 Message about Perl::LanguageServer has crashed 5 times 336 | 337 | This is a problem when more than one instance of Perl::LanguageServer is running. 338 | Upgrade to Version 2.4.0 solves this problem. 339 | 340 | =head3 The program I want to debug needs some input via stdin 341 | 342 | You can read stdin from a file during debugging. To do so add the following parameter 343 | to your C: 344 | 345 | C<< 346 | "args": [ "E", "/path/to/stdin.txt" ] 347 | >> 348 | 349 | e.g. 350 | 351 | C<< 352 | { 353 | "type": "perl", 354 | "request": "launch", 355 | "name": "Perl-Debug", 356 | "program": "${workspaceFolder}/${relativeFile}", 357 | "stopOnEntry": true, 358 | "reloadModules": true, 359 | "env": { 360 | "REQUEST_METHOD": "POST", 361 | "CONTENT_TYPE": "application/x-www-form-urlencoded", 362 | "CONTENT_LENGTH": 34 363 | } 364 | "args": [ "E", "/path/to/stdin.txt" ] 365 | } 366 | >> 367 | 368 | =head3 Carton support 369 | 370 | If you are using LL to manage dependencies, add the full path to the Carton C dir to your workspace settings file at C<.vscode/settings.json>. For example: 371 | 372 | =head4 Linux 373 | 374 | 375 | { 376 | "perl.perlInc": ["/home/myusername/projects/myprojectname/local/lib/perl5"] 377 | } 378 | 379 | =head4 Mac 380 | 381 | 382 | { 383 | "perl.perlInc": ["/Users/myusername/projects/myprojectname/local/lib/perl5"] 384 | } 385 | 386 | =head2 Known Issues 387 | 388 | Does not yet work on windows, due to issues with reading from stdin. 389 | I wasn't able to find a reliable way to do a non-blocking read from stdin on windows. 390 | I would be happy, if anyone knows how to do this in Perl. 391 | 392 | Anyway, Perl::LanguageServer runs without problems inside of Windows Subsystem for Linux (WSL). 393 | 394 | =head2 Release Notes 395 | 396 | see CHANGELOG.md 397 | 398 | =head2 More Info 399 | 400 | =over 401 | 402 | =item * Presentation at German Perl Workshop 2020: 403 | 404 | =back 405 | 406 | https://github.com/richterger/Perl-LanguageServer/blob/master/docs/Perl-LanguageServer%20und%20Debugger%20f%C3%BCr%20Visual%20Studio%20Code%20u.a.%20Editoren%20-%20Perl%20Workshop%202020.pdf 407 | 408 | =over 409 | 410 | =item * Github: https://github.com/richterger/Perl-LanguageServer 411 | 412 | =item * MetaCPAN: https://metacpan.org/release/Perl-LanguageServer 413 | 414 | =back 415 | 416 | For reporting bugs please use GitHub issues. 417 | 418 | =head2 References 419 | 420 | This is a Language Server and Debug Protocol Adapter for Perl 421 | 422 | It implements the Language Server Protocol which provides 423 | syntax-checking, symbol search, etc. Perl to various editors, for 424 | example Visual Studio Code or Atom. 425 | 426 | https://microsoft.github.io/language-server-protocol/specification 427 | 428 | It also implements the Debug Adapter Protocol, which allows debugging 429 | with various editors/includes 430 | 431 | https://microsoft.github.io/debug-adapter-protocol/overview 432 | 433 | To use both with Visual Studio Code, install the extension "perl" 434 | 435 | https://marketplace.visualstudio.com/items?itemName=richterger.perl 436 | 437 | Any comments and patches are welcome. 438 | 439 | =head2 LICENSE AND COPYRIGHT 440 | 441 | Copyright 2018-2022 Gerald Richter. 442 | 443 | This program is free software; you can redistribute it and/or modify it 444 | under the terms of the Artistic License (2.0). You may obtain a 445 | copy of the full license at: 446 | 447 | LL 448 | 449 | Any use, modification, and distribution of the Standard or Modified 450 | Versions is governed by this Artistic License. By using, modifying or 451 | distributing the Package, you accept this license. Do not use, modify, 452 | or distribute the Package, if you do not accept this license. 453 | 454 | If your Modified Version has been derived from a Modified Version made 455 | by someone other than you, you are nevertheless required to ensure that 456 | your Modified Version complies with the requirements of this license. 457 | 458 | This license does not grant you the right to use any trademark, service 459 | mark, tradename, or logo of the Copyright Holder. 460 | 461 | This license includes the non-exclusive, worldwide, free-of-charge 462 | patent license to make, have made, use, offer to sell, sell, import and 463 | otherwise transfer the Package with respect to any patent claims 464 | licensable by the Copyright Holder that are necessarily infringed by the 465 | Package. If you institute patent litigation (including a cross-claim or 466 | counterclaim) against any party alleging that the Package constitutes 467 | direct or contributory patent infringement, then this Artistic License 468 | to you shall terminate on the date that such litigation is filed. 469 | 470 | Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER 471 | AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. 472 | THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR 473 | PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY 474 | YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR 475 | CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR 476 | CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, 477 | EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 478 | -------------------------------------------------------------------------------- /clients/vscode/perl/.gitignore: -------------------------------------------------------------------------------- 1 | out 2 | node_modules 3 | .vscode-test/ 4 | *.vsix 5 | README.publish 6 | 7 | -------------------------------------------------------------------------------- /clients/vscode/perl/.vscode/extensions.json: -------------------------------------------------------------------------------- 1 | { 2 | // See http://go.microsoft.com/fwlink/?LinkId=827846 3 | // for the documentation about the extensions.json format 4 | "recommendations": [ 5 | "eg2.tslint" 6 | ] 7 | } -------------------------------------------------------------------------------- /clients/vscode/perl/.vscode/launch.json: -------------------------------------------------------------------------------- 1 | // A launch configuration that compiles the extension and then opens it inside a new window 2 | // Use IntelliSense to learn about possible attributes. 3 | // Hover to view descriptions of existing attributes. 4 | // For more information, visit: https://go.microsoft.com/fwlink/?linkid=830387 5 | { 6 | "version": "0.2.0", 7 | "configurations": [ 8 | { 9 | "name": "Extension", 10 | "type": "extensionHost", 11 | "request": "launch", 12 | "runtimeExecutable": "${execPath}", 13 | "args": [ 14 | "--extensionDevelopmentPath=${workspaceFolder}" 15 | ], 16 | "outFiles": [ 17 | "${workspaceFolder}/out/**/*.js" 18 | ], 19 | "preLaunchTask": "npm: watch" 20 | }, 21 | { 22 | "name": "Extension Tests", 23 | "type": "extensionHost", 24 | "request": "launch", 25 | "runtimeExecutable": "${execPath}", 26 | "args": [ 27 | "--extensionDevelopmentPath=${workspaceFolder}", 28 | "--extensionTestsPath=${workspaceFolder}/out/test" 29 | ], 30 | "outFiles": [ 31 | "${workspaceFolder}/out/test/**/*.js" 32 | ], 33 | "preLaunchTask": "npm: watch" 34 | } 35 | ] 36 | } 37 | -------------------------------------------------------------------------------- /clients/vscode/perl/.vscode/settings.json: -------------------------------------------------------------------------------- 1 | // Place your settings in this file to overwrite default and user settings. 2 | { 3 | "files.exclude": { 4 | "out": false // set this to true to hide the "out" folder with the compiled JS files 5 | }, 6 | "search.exclude": { 7 | "out": true // set this to false to include "out" folder in search results 8 | } 9 | } -------------------------------------------------------------------------------- /clients/vscode/perl/.vscode/tasks.json: -------------------------------------------------------------------------------- 1 | // See https://go.microsoft.com/fwlink/?LinkId=733558 2 | // for the documentation about the tasks.json format 3 | { 4 | "version": "2.0.0", 5 | "tasks": [ 6 | { 7 | "type": "npm", 8 | "script": "watch", 9 | "problemMatcher": "$tsc-watch", 10 | "isBackground": true, 11 | "presentation": { 12 | "reveal": "never" 13 | }, 14 | "group": { 15 | "kind": "build", 16 | "isDefault": true 17 | } 18 | } 19 | ] 20 | } -------------------------------------------------------------------------------- /clients/vscode/perl/.vscodeignore: -------------------------------------------------------------------------------- 1 | .vscode/** 2 | .vscode-test/** 3 | out/test/** 4 | out/**/*.map 5 | src/** 6 | .gitignore 7 | tsconfig.json 8 | vsc-extension-quickstart.md 9 | tslint.json 10 | README.publish 11 | -------------------------------------------------------------------------------- /clients/vscode/perl/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Change Log 2 | 3 | ## 2.6.2 `2023-12-23` 4 | 5 | - avoid given/when/smartmatch because these features are deprecated in perl 5.38 (#199) [real-dam] 6 | 7 | ## 2.6.1 `2023-07-26` 8 | 9 | - Fix: Formatting with perltidy was broken in 2.6.0 10 | 11 | ## 2.6.0 `2023-07-23` 12 | 13 | - Add debug setting for running as different user. See sudoUser setting. (#174) [wielandp] 14 | - Allow to use a string for debuggee arguments. (#149, #173) [wielandp] 15 | - Add stdin redirection (#166) [wielandp] 16 | - Add link to issues to META files (#168) [szabgab/issues] 17 | - Add support for podman 18 | - Add support for run Perl::LanguageServer outside, but debugger inside a container 19 | - Add setting useTaintForSyntaxCheck. If true, use taint mode for syntax check (#172) [wielandp] 20 | - Add setting useTaintForDebug. If true, use taint mode inside debugger (#181) [wielandp] 21 | - Add debug adapter request `source`, which allows to display source of eval or file that are not available to vscode (#180) [wielandp] 22 | 23 | - Fix: Spelling (#170, #171) [pkg-perl-tools] 24 | - Fix: Convert charset encoding of debugger output according to current locale (#167) [wielandp] 25 | - Fix: Fix diagnostic notifications override on clients (based on #185) [bmeneg] 26 | 27 | ## 2.5.0 `2023-02-05` 28 | 29 | - Set minimal Perl version to 5.16 (#91) 30 | - Per default environment from vscode will be passed to debuggee, syntax check and perltidy. 31 | - Add configuration `disablePassEnv` to not pass environment variables. 32 | - Support for `logLevel` and `logFile` settings via LanguageServer protocol and 33 | not only via command line options (#97) [schellj] 34 | 35 | - Fix: "No DB::DB routine defined" (#91) [peterdragon] 36 | - Fix: Typos and spelling in README (#159) [dseynhae] 37 | - Fix: Update call to gensym(), to fix 'strict subs' error (#164) [KohaAloha] 38 | - Convert identention from tabs to spaces and remove trailing whitespaces 39 | 40 | ## 2.4.0 `2022-11-18` 41 | 42 | - Choose a different port for debugAdapterPort if it is already in use. This 43 | avoids trouble with starting `Perl::LanguageServer` if another instance 44 | of `Perl::LanguageServer` is running on the same machine (thanks to hakonhagland) 45 | - Add configuration `debugAdapterPortRange`, for choosing range of port for dynamic 46 | port assignment 47 | - Add support for using LanguageServer and debugger inside a Container. 48 | Currently docker containers und containers running inside kubernetes are supported. 49 | - When starting debugger session and `stopOnEntry` is false, do not switch to sourefile 50 | where debugger would stop, when `stopOnEntry` is true. 51 | - Added some FAQs in README 52 | 53 | - Fix: Debugger stopps at random locations 54 | - Fix: debugAdapterPort is now numeric 55 | - Fix: debugging loop with each statement (#107) 56 | - Fix: display of arrays in variables pane on mac (#120) 57 | - Fix: encoding for `perltidy` (#127) 58 | - Fix: return error if `perltidy` fails, so text is not removed by failing 59 | formatting request (#87) 60 | - Fix: FindBin does not work when checking syntax (#16) 61 | 62 | ## 2.3.0 `2021-09-26` 63 | 64 | - Arguments section in Variable lists now `@ARGV` and `@_` during debugging (#105) 65 | - `@_` is now correctly evaluated inside of debugger console 66 | - `$#foo` is now correctly evaluated inside of debugger console 67 | - Default debug configuration is now automatically provided without 68 | the need to create a `launch.json` first (#103) 69 | - Add Option `cacheDir` to specify location of cache dir (#113) 70 | - Fix: Debugger outputted invalid thread reference causes "no such coroutine" message, 71 | so watchs and code from the debug console is not expanded properly 72 | - Fix: LanguageServer hangs when multiple request send at once from VSCode to LanguageServer 73 | - Fix: cwd parameter for debugger in launch.json had no effect (#99) 74 | - Fix: Correctly handle paths with drive letters on windows 75 | - Fix: sshArgs parameter was not declared as array (#109) 76 | - Disable syntax check on windows, because it blocks the whole process when running on windows, 77 | until handling of child's processes is fixed 78 | - Fixed spelling (#86,#96,#101) [chrstphrchvz,davorg,aluaces] 79 | 80 | ## 2.2.0 `2021-02-21` 81 | - Parser now supports Moose method modifieres before, after and around, 82 | so they can be used in symbol view and within reference search 83 | - Support Format Document and Format Selection via perltidy 84 | - Add logFile config option 85 | - Add perlArgs config option to pass options to Perl interpreter. Add some documentation for config options. 86 | - Add disableCache config option to make LanguageServer usable with readonly directories. 87 | - updated dependencies package.json & package-lock.json 88 | - Fix deep recursion in SymbolView/Parser which was caused by function prototypes. 89 | Solves also #65 90 | - Fix duplicate req id's that caused cleanup of still 91 | running threads which in turn caused the LanguageServer to hang 92 | - Prevent dereferencing an undefined value (#63) [Heiko Jansen] 93 | - Fix datatype of cwd config options (#47) 94 | - Use perlInc setting also for LanguageServer itself (based only pull request #54 from ALANVF) 95 | - Catch Exceptions during display of variables inside debugger 96 | - Fix detecting duplicate LanguageServer processes 97 | - Fix spelling in documentation (#56) [Christopher Chavez] 98 | - Remove notice about Compiler::Lexer 0.22 bugs (#55) [Christopher Chavez] 99 | - README: Typo and grammar fixes. Add Carton lib path instructions. (#40) [szTheory] 100 | - README: Markdown code block formatting (#42) [szTheory] 101 | - Makefile.PL: add META_MERGE with GitHub info (#32) [Christopher Chavez] 102 | - search.cpan.org retired, replace with metacpan.org (#31) [Christopher Chavez] 103 | 104 | ## 2.1.0 `2020-06-27` 105 | - Improve Symbol Parser (fix parsing of anonymous subs) 106 | - showLocalSymbols 107 | - function names in breadcrump 108 | - Signature Help for function/method arguments 109 | - Add Presentation on Perl Workshop 2020 to repos 110 | - Remove Compiler::Lexer from distribution since 111 | version is available on CPAN 112 | - Make stdout unbuffered while debugging 113 | - Make debugger use perlInc setting 114 | - Fix fileFilter setting 115 | - Sort Arrays numerically in variables view of debugger 116 | - Use rootUri if workspaceFolders not given 117 | - Fix env config setting 118 | - Recongnice changes in config of perlCmd 119 | 120 | ## 2.0.2 `2020-01-22` 121 | - Plugin: Fix command line parameters for plink 122 | - Perl::LanguageServer: Fix handling of multiple parallel request, improve symlink handling, add support for UNC paths in path mapping, improve logging for logLevel = 1 123 | 124 | ## 2.0.1 `2020-01-14` 125 | Added support for reloading Perl module while debugging, make log level configurable, make sure tooltips don't call functions 126 | 127 | ## 2.0.0 `2020-01-01` 128 | Added Perl debugger 129 | 130 | ## 0.9.0 `2019-05-03` 131 | Fix issues in the Perl part, make sure to update Perl::LanguageServer from cpan 132 | 133 | ## 0.0.3 `2018-09-08` 134 | Fix issue with not reading enough from stdin, which caused LanguageServer to hang sometimes 135 | 136 | ## 0.0.2 `2018-07-21` 137 | Fix quitting issue when starting Perl::LanguageServer, more fixes are in the Perl part 138 | 139 | ## 0.0.1 `2018-07-13` 140 | Initial Version 141 | 142 | 143 | -------------------------------------------------------------------------------- /clients/vscode/perl/LICENSE: -------------------------------------------------------------------------------- 1 | vscode-extension-perl 2 | 3 | LICENSE AND COPYRIGHT 4 | 5 | Copyright 2018-2022 Gerald Richter. 6 | 7 | This program is free software; you can redistribute it and/or modify it 8 | under the terms of the the Artistic License (2.0). You may obtain a 9 | copy of the full license at: 10 | 11 | L 12 | 13 | Any use, modification, and distribution of the Standard or Modified 14 | Versions is governed by this Artistic License. By using, modifying or 15 | distributing the Package, you accept this license. Do not use, modify, 16 | or distribute the Package, if you do not accept this license. 17 | 18 | If your Modified Version has been derived from a Modified Version made 19 | by someone other than you, you are nevertheless required to ensure that 20 | your Modified Version complies with the requirements of this license. 21 | 22 | This license does not grant you the right to use any trademark, service 23 | mark, tradename, or logo of the Copyright Holder. 24 | 25 | This license includes the non-exclusive, worldwide, free-of-charge 26 | patent license to make, have made, use, offer to sell, sell, import and 27 | otherwise transfer the Package with respect to any patent claims 28 | licensable by the Copyright Holder that are necessarily infringed by the 29 | Package. If you institute patent litigation (including a cross-claim or 30 | counterclaim) against any party alleging that the Package constitutes 31 | direct or contributory patent infringement, then this Artistic License 32 | to you shall terminate on the date that such litigation is filed. 33 | 34 | Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER 35 | AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. 36 | THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR 37 | PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY 38 | YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR 39 | CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR 40 | CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, 41 | EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 42 | 43 | -------------------------------------------------------------------------------- /clients/vscode/perl/README.md: -------------------------------------------------------------------------------- 1 | # Perl::LanguageServer 2 | 3 | Language Server and Debug Protocol Adapter for Perl 4 | 5 | ## Features 6 | 7 | * Language Server 8 | 9 | * Syntax checking 10 | * Symbols in file 11 | * Symbols in workspace/directory 12 | * Goto Definition 13 | * Find References 14 | * Call Signatures 15 | * Supports multiple workspace folders 16 | * Document and selection formatting via perltidy 17 | * Run on remote system via ssh 18 | * Run inside docker container 19 | * Run inside kubernetes 20 | 21 | * Debugger 22 | 23 | * Run, pause, step, next, return 24 | * Support for coro threads 25 | * Breakpoints 26 | * Conditional breakpoints 27 | * Breakpoints can be set while program runs and for modules not yet loaded 28 | * Variable view, can switch to every stack frame or coro thread 29 | * Set variable 30 | * Watch variable 31 | * Tooltips with variable values 32 | * Evaluate perl code in debuggee, in context of every stack frame of coro thread 33 | * Automatically reload changed Perl modules while debugging 34 | * Debug multiple perl programs at once 35 | * Run on remote system via ssh 36 | * Run inside docker container 37 | * Run inside kubernetes 38 | 39 | ## Requirements 40 | 41 | You need to install the perl module Perl::LanguageServer to make this extension work, 42 | e.g. run `cpan Perl::LanguageServer` on your target system. 43 | 44 | Please make sure to always run the newest version of Perl::LanguageServer as well. 45 | 46 | NOTE: Perl::LanguageServer depend on AnyEvent::AIO and Coro. There is a warning that 47 | this might not work with newer Perls. It works fine for Perl::LanguageServer. So just 48 | confirm the warning and install it. 49 | 50 | Perl::LanguageServer depends on other Perl modules. It is a good idea to install most 51 | of then with your linux package manager. 52 | 53 | e.g. on Debian/Ubuntu run: 54 | 55 | ``` 56 | 57 | sudo apt install build-essential libanyevent-perl libclass-refresh-perl libcompiler-lexer-perl \ 58 | libdata-dump-perl libio-aio-perl libjson-perl libmoose-perl libpadwalker-perl \ 59 | libscalar-list-utils-perl libcoro-perl 60 | 61 | sudo cpan Perl::LanguageServer 62 | 63 | ``` 64 | 65 | e.g. on Centos 7 run: 66 | 67 | ``` 68 | 69 | sudo yum install perl-App-cpanminus perl-AnyEvent-AIO perl-Coro 70 | sudo cpanm Class::Refresh 71 | sudo cpanm Compiler::Lexer 72 | sudo cpanm Hash::SafeKeys 73 | sudo cpanm Perl::LanguageServer 74 | 75 | ``` 76 | 77 | In case any of the above packages are not available for your os version, just 78 | leave them out. The cpan command will install missing dependencies. In case 79 | the test fails, when running cpan `install`, you should try to run `force install`. 80 | 81 | ## Extension Settings 82 | 83 | This extension contributes the following settings: 84 | 85 | * `perl.enable`: enable/disable this extension 86 | * `perl.sshAddr`: ip address of remote system 87 | * `perl.sshPort`: optional, port for ssh to remote system 88 | * `perl.sshUser`: user for ssh login 89 | * `perl.sshCmd`: defaults to ssh on unix and plink on windows 90 | * `perl.sshWorkspaceRoot`: path of the workspace root on remote system 91 | * `perl.perlCmd`: defaults to perl 92 | * `perl.perlArgs`: additional arguments passed to the perl interpreter that starts the LanguageServer 93 | * `useTaintForSyntaxCheck`: if true, use taint mode for syntax check 94 | * `perl.sshArgs`: optional arguments for ssh 95 | * `perl.pathMap`: mapping of local to remote paths 96 | * `perl.perlInc`: array with paths to add to perl library path. This setting is used by the syntax checker and for the debuggee and also for the LanguageServer itself. 97 | * `perl.fileFilter`: array for filtering perl file, defaults to [*.pm,*.pl] 98 | * `perl.ignoreDirs`: directories to ignore, defaults to [.vscode, .git, .svn] 99 | * `perl.debugAdapterPort`: port to use for connection between vscode and debug adapter inside Perl::LanguageServer. 100 | * `perl.debugAdapterPortRange`: if debugAdapterPort is in use try ports from debugAdapterPort to debugAdapterPort + debugAdapterPortRange. Default 100. 101 | * `perl.showLocalVars`: if true, show also local variables in symbol view 102 | * `perl.logLevel`: Log level 0-2. 103 | * `perl.logFile`: If set, log output is written to the given logfile, instead of displaying it in the vscode output pane. Log output is always appended. Only use during debugging of LanguageServer itself. 104 | * `perl.disableCache`: If true, the LanguageServer will not cache the result of parsing source files on disk, so it can be used within readonly directories 105 | * `perl.containerCmd`: If set Perl::LanguageServer can run inside a container. Options are: 'docker', 'docker-compose', 'kubectl' 106 | * `perl.containerArgs`: arguments for containerCmd. Varies depending on containerCmd. 107 | * `perl.containerMode`: To start a new container, set to 'run', to execute inside an existing container set to 'exec'. Note: kubectl only supports 'exec' 108 | * `perl.containerName`: Image to start or container to exec inside or pod to use 109 | 110 | ## Debugger Settings for launch.json 111 | 112 | * `type`: needs to be `perl` 113 | * `request`: only `launch` is supported (this is a restriction of perl itself) 114 | * `name`: name of this debug configuration 115 | * `program`: path to perl program to start 116 | * `stopOnEntry`: if true, program will stop on entry 117 | * `args`: optional, array or string with arguments for perl program 118 | * `env`: optional, object with environment settings 119 | * `cwd`: optional, change working directory before launching the debuggee 120 | * `reloadModules`: if true, automatically reload changed Perl modules while debugging 121 | * `sudoUser`: optional, if set run debug process with sudo -u \. 122 | * `useTaintForDebug`: optional, if true run debug process with -T (taint mode). 123 | * `containerCmd`: If set debugger runs inside a container. Options are: 'docker', 'docker-compose', 'podman', 'kubectl' 124 | * `containerArgs`: arguments for containerCmd. Varies depending on containerCmd. 125 | * `containerMode`: To start a new container, set to 'run', to debug inside an existing container set to 'exec'. Note: kubectl only supports 'exec' 126 | * `containerName`: Image to start or container to exec inside or pod to use 127 | * `pathMap`: mapping of local to remote paths for this debug session (overwrites global `perl.path_map`) 128 | 129 | ## Remote syntax check & debugging 130 | 131 | If you developing on a remote machine, you can instruct the Perl::LanguageServer to 132 | run on that remote machine, so the correct modules etc. are available for syntax check and debugger is started on the remote machine. 133 | To do so set sshAddr and sshUser, preferably in your workspace configuration. 134 | 135 | Example: 136 | 137 | ```json 138 | "sshAddr": "10.11.12.13", 139 | "sshUser": "root" 140 | ``` 141 | 142 | Also set sshWorkspaceRoot, so the local workspace path can be mapped to the remote one. 143 | 144 | Example: if your local path is \\10.11.12.13\share\path\to\ws and on the remote machine you have /path/to/ws 145 | 146 | ```json 147 | "sshWorkspaceRoot": "/path/to/ws" 148 | ``` 149 | 150 | The other possibility is to provide a pathMap. This allows one to having multiple mappings. 151 | 152 | Examples: 153 | 154 | ```json 155 | "perl.pathMap": [ 156 | ["remote uri", "local uri"], 157 | ["remote uri", "local uri"] 158 | ] 159 | 160 | "perl.pathMap": [ 161 | [ 162 | "file:///", 163 | "file:///home/systems/mountpoint/" 164 | ] 165 | ] 166 | ``` 167 | 168 | ## Syntax check & debugging inside a container 169 | 170 | You can run the LanguageServer and/or debugger inside 171 | a container by setting `containerCmd` and `conatinerName`. 172 | There are more container options, see above. 173 | 174 | .vscode/settings.json 175 | 176 | ```json 177 | { 178 | "perl": { 179 | "enable": true, 180 | "containerCmd": "docker", 181 | "containerName": "perl_container", 182 | } 183 | } 184 | ``` 185 | 186 | This will start the whole Perl::LanguageServer inside the container. This is espacally 187 | helpfull to make syntax check working, if there is a different setup inside 188 | and outside the container. 189 | 190 | In this case you need to tell the Perl::LanguageServer how to map local paths 191 | to paths inside the container. This is done by setting `perl.pathMap` (see above). 192 | 193 | Example: 194 | 195 | ```json 196 | "perl.pathMap": [ 197 | [ 198 | "file:///path/inside/the/container", 199 | "file:///local/path/outside/the/container" 200 | ] 201 | ] 202 | ``` 203 | 204 | It's also possible to run the LanguageServer outside the container and only 205 | the debugger inside the container. This is especially helpfull, when the 206 | container is not always running, while you are editing. 207 | To make only the debugger running inside the container, put 208 | `containerCmd`, `conatinerName` and `pasth_map` in your `launch.json`. 209 | You can have different setting for each debug session. 210 | 211 | Normaly the arguments for the `containerCmd` are automatically build. In case 212 | you want to use an unsupported `containerCmd` you need to specifiy 213 | apropriate `containerArgs`. 214 | 215 | 216 | ## FAQ 217 | 218 | ### Working directory is not defined 219 | 220 | It is not defined what the current working directory is at the start of a perl program. 221 | So Perl::LanguageServer makes no assumptions about it. To solve the problem you can set 222 | the directory via cwd configuration parameter in launch.json for debugging. 223 | 224 | ### Module not found when debugging or during syntax check 225 | 226 | If you reference a module with a relative path or if you assume that the current working directory 227 | is part of the Perl search path, it will not work. 228 | Instead set the perl include path to a fixed absolute path. In your settings.json do something like: 229 | 230 | ``` 231 | "perl.perlInc": [ 232 | "/path/a/lib", 233 | "/path/b/lib", 234 | "/path/c/lib", 235 | ], 236 | ``` 237 | Include path works for syntax check and inside of debugger. 238 | `perl.perlInc` should be an absolute path. 239 | 240 | ### AnyEvent, Coro Warning during install 241 | 242 | You need to install the AnyEvent::IO and Coro. Just ignore the warning that it might not work. For Perl::LanguageServer it works fine. 243 | 244 | ### 'richterger.perl' failed: options.port should be >= 0 and < 65536 245 | 246 | Change port setting from string to integer 247 | 248 | ### Error "Can't locate MODULE_NAME" 249 | 250 | Please make sure the path to the module is in `perl.perlInc` setting and use absolute path names in the perlInc settings 251 | or make sure you are running in the expected directory by setting the `cwd` setting in the lauch.json. 252 | 253 | ### ERROR: Unknown perlmethod _rpcnot_setTraceNotification 254 | 255 | This is not an issue, that just means that not all features of the debugging protocol are implemented. 256 | Also it says ERROR, it's just a warning and you can safely ignore it. 257 | 258 | ### The debugger sometimes stops at random places 259 | 260 | Upgrade to Version 2.4.0 261 | 262 | ### Message about Perl::LanguageServer has crashed 5 times 263 | 264 | This is a problem when more than one instance of Perl::LanguageServer is running. 265 | Upgrade to Version 2.4.0 solves this problem. 266 | 267 | ### The program I want to debug needs some input via stdin 268 | 269 | You can read stdin from a file during debugging. To do so add the following parameter 270 | to your `launch.json`: 271 | 272 | ``` 273 | "args": [ "<", "/path/to/stdin.txt" ] 274 | ``` 275 | 276 | e.g. 277 | 278 | ``` 279 | { 280 | "type": "perl", 281 | "request": "launch", 282 | "name": "Perl-Debug", 283 | "program": "${workspaceFolder}/${relativeFile}", 284 | "stopOnEntry": true, 285 | "reloadModules": true, 286 | "env": { 287 | "REQUEST_METHOD": "POST", 288 | "CONTENT_TYPE": "application/x-www-form-urlencoded", 289 | "CONTENT_LENGTH": 34 290 | } 291 | "args": [ "<", "/path/to/stdin.txt" ] 292 | } 293 | ``` 294 | 295 | 296 | ### Carton support 297 | 298 | If you are using [Carton](https://metacpan.org/pod/Carton) to manage dependencies, add the full path to the Carton `lib` dir to your workspace settings file at `.vscode/settings.json`. For example: 299 | 300 | #### Linux 301 | 302 | ```json 303 | { 304 | "perl.perlInc": ["/home/myusername/projects/myprojectname/local/lib/perl5"] 305 | } 306 | ``` 307 | 308 | #### Mac 309 | 310 | ```json 311 | { 312 | "perl.perlInc": ["/Users/myusername/projects/myprojectname/local/lib/perl5"] 313 | } 314 | ``` 315 | 316 | ## Known Issues 317 | 318 | Does not yet work on windows, due to issues with reading from stdin. 319 | I wasn't able to find a reliable way to do a non-blocking read from stdin on windows. 320 | I would be happy, if anyone knows how to do this in Perl. 321 | 322 | Anyway, Perl::LanguageServer runs without problems inside of Windows Subsystem for Linux (WSL). 323 | 324 | ## Release Notes 325 | 326 | see CHANGELOG.md 327 | 328 | ## More Info 329 | 330 | - Presentation at German Perl Workshop 2020: 331 | 332 | https://github.com/richterger/Perl-LanguageServer/blob/master/docs/Perl-LanguageServer%20und%20Debugger%20f%C3%BCr%20Visual%20Studio%20Code%20u.a.%20Editoren%20-%20Perl%20Workshop%202020.pdf 333 | 334 | - Github: https://github.com/richterger/Perl-LanguageServer 335 | 336 | - MetaCPAN: https://metacpan.org/release/Perl-LanguageServer 337 | 338 | For reporting bugs please use GitHub issues. 339 | 340 | ## References 341 | 342 | This is a Language Server and Debug Protocol Adapter for Perl 343 | 344 | It implements the Language Server Protocol which provides 345 | syntax-checking, symbol search, etc. Perl to various editors, for 346 | example Visual Studio Code or Atom. 347 | 348 | https://microsoft.github.io/language-server-protocol/specification 349 | 350 | It also implements the Debug Adapter Protocol, which allows debugging 351 | with various editors/includes 352 | 353 | https://microsoft.github.io/debug-adapter-protocol/overview 354 | 355 | To use both with Visual Studio Code, install the extension "perl" 356 | 357 | https://marketplace.visualstudio.com/items?itemName=richterger.perl 358 | 359 | Any comments and patches are welcome. 360 | 361 | ## LICENSE AND COPYRIGHT 362 | 363 | Copyright 2018-2022 Gerald Richter. 364 | 365 | This program is free software; you can redistribute it and/or modify it 366 | under the terms of the Artistic License (2.0). You may obtain a 367 | copy of the full license at: 368 | 369 | L 370 | 371 | Any use, modification, and distribution of the Standard or Modified 372 | Versions is governed by this Artistic License. By using, modifying or 373 | distributing the Package, you accept this license. Do not use, modify, 374 | or distribute the Package, if you do not accept this license. 375 | 376 | If your Modified Version has been derived from a Modified Version made 377 | by someone other than you, you are nevertheless required to ensure that 378 | your Modified Version complies with the requirements of this license. 379 | 380 | This license does not grant you the right to use any trademark, service 381 | mark, tradename, or logo of the Copyright Holder. 382 | 383 | This license includes the non-exclusive, worldwide, free-of-charge 384 | patent license to make, have made, use, offer to sell, sell, import and 385 | otherwise transfer the Package with respect to any patent claims 386 | licensable by the Copyright Holder that are necessarily infringed by the 387 | Package. If you institute patent litigation (including a cross-claim or 388 | counterclaim) against any party alleging that the Package constitutes 389 | direct or contributory patent infringement, then this Artistic License 390 | to you shall terminate on the date that such litigation is filed. 391 | 392 | Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER 393 | AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. 394 | THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR 395 | PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY 396 | YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR 397 | CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR 398 | CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, 399 | EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 400 | 401 | 402 | -------------------------------------------------------------------------------- /clients/vscode/perl/out/dbgforward.js: -------------------------------------------------------------------------------- 1 | var port = 13603; 2 | var retries = 10 ; 3 | 4 | if (process.argv.length > 2) 5 | port = parseInt(process.argv[2]) ; 6 | 7 | var net = require("net"); 8 | 9 | var s = new net.Socket(); 10 | 11 | s.on("error", function() 12 | { 13 | if (retries-- > 0) 14 | { 15 | setTimeout (function () 16 | { 17 | s.connect(port, '127.0.0.1') ; 18 | }, 200); 19 | } 20 | }) ; 21 | 22 | s.on("connect", function() 23 | { 24 | process.stdin.on('data', function (data) 25 | { 26 | s.write (data) ; 27 | }); 28 | }) ; 29 | 30 | s.on("data", function(data) 31 | { 32 | process.stdout.write (data) ; 33 | }); 34 | 35 | s.connect(port, '127.0.0.1') ; 36 | 37 | -------------------------------------------------------------------------------- /clients/vscode/perl/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "perl", 3 | "displayName": "Perl", 4 | "description": "Language Server and Debugger for Perl", 5 | "version": "2.6.2", 6 | "publisher": "richterger", 7 | "repository": "https://github.com/richterger/Perl-LanguageServer", 8 | "license": "SEE LICENSE IN LICENSE", 9 | "engines": { 10 | "vscode": "^1.58.0" 11 | }, 12 | "categories": [ 13 | "Debuggers", 14 | "Programming Languages", 15 | "Linters" 16 | ], 17 | "activationEvents": [ 18 | "onLanguage:perl", 19 | "onDebug" 20 | ], 21 | "main": "./out/extension", 22 | "contributes": { 23 | "configuration": { 24 | "type": "object", 25 | "title": "Perl configuration", 26 | "properties": { 27 | "perl.enable": { 28 | "type": "boolean", 29 | "default": true, 30 | "description": "enable/disable this extension" 31 | }, 32 | "perl.logLevel": { 33 | "type": "integer", 34 | "default": 0, 35 | "description": "Log level 0-2" 36 | }, 37 | "perl.logFile": { 38 | "type": "string", 39 | "default": null, 40 | "description": "If set, log output is written to the given logfile, instead of displaying it in the vscode output pane. Log output is always appended so you are responsible for rotating the file." 41 | }, 42 | "perl.sshAddr": { 43 | "type": "string", 44 | "default": null, 45 | "description": "ip address of remote system" 46 | }, 47 | "perl.sshPort": { 48 | "type": "string", 49 | "default": null, 50 | "description": "optional, port for ssh to remote system" 51 | }, 52 | "perl.sshUser": { 53 | "type": "string", 54 | "default": null, 55 | "description": "user for ssh login" 56 | }, 57 | "perl.sshCmd": { 58 | "type": "string", 59 | "default": null, 60 | "description": "defaults to ssh on unix and plink on windows" 61 | }, 62 | "perl.sshWorkspaceRoot": { 63 | "type": "string", 64 | "default": null, 65 | "description": "path of the workspace root on remote system" 66 | }, 67 | "perl.perlCmd": { 68 | "type": "string", 69 | "default": null, 70 | "description": "defaults to perl" 71 | }, 72 | "perl.sshArgs": { 73 | "type": "array", 74 | "default": null, 75 | "description": "optional arguments for ssh" 76 | }, 77 | "perl.containerCmd": { 78 | "type": "string", 79 | "default": null, 80 | "description": "If set Perl::LanguageServer can run inside a container. Options are: 'docker', 'docker-compose', 'podman', 'kubectl'" 81 | }, 82 | "perl.containerArgs": { 83 | "type": "array", 84 | "default": null, 85 | "description": "arguments for containerCmd. Varies depending on containerCmd." 86 | }, 87 | "perl.containerMode": { 88 | "type": "string", 89 | "default": "exec", 90 | "description": "To start a new container, set to 'run', to execute inside an existing container set to 'exec'. Note: kubectl only supports 'exec'" 91 | }, 92 | "perl.containerName": { 93 | "type": "string", 94 | "default": null, 95 | "description": "Image to start or container to exec inside or pod to use" 96 | }, 97 | "perl.env": { 98 | "type": "object", 99 | "description": "object with environment settings for command that starts the LanguageServer, e.g. can be used to set KUBECONFIG.", 100 | "default": null 101 | }, 102 | "perl.disablePassEnv": { 103 | "type": "boolean", 104 | "description": "per default enviroment from vscode will be passed to debuggee, syntax check and perltidy. If set to true, no enviroment variables will be passed.", 105 | "default": null 106 | }, 107 | "perl.pathMap": { 108 | "type": "array", 109 | "default": null, 110 | "description": "mapping of local to remote paths" 111 | }, 112 | "perl.perlInc": { 113 | "type": "array", 114 | "default": null, 115 | "description": "array with paths to add to perl library path. This setting is used by the syntax checker and for the debuggee and also for the LanguageServer itself. perl.perlInc should be absolute paths." 116 | }, 117 | "perl.useTaintForSyntaxCheck": { 118 | "type": "boolean", 119 | "default": false, 120 | "description": "Use -T for syntax check." 121 | }, 122 | "perl.fileFilter": { 123 | "type": "array", 124 | "default": null, 125 | "description": "array for filtering perl file, defaults to *.pm|*.pl" 126 | }, 127 | "perl.ignoreDirs": { 128 | "type": "array", 129 | "default": null, 130 | "description": "directories to ignore, defaults to .vscode, .git, .svn" 131 | }, 132 | "perl.cacheDir": { 133 | "type": "string", 134 | "default": null, 135 | "description": "directory for caching of parsed symbols, if the directory does not exists, it will be created, defaults to ${workspace}/.vscode/perl-lang. This should be one unqiue directory per project and an absolute path." 136 | }, 137 | "perl.showLocalVars": { 138 | "type": "boolean", 139 | "default": false, 140 | "description": "if true, show also local variables in symbol view" 141 | }, 142 | "perl.disableCache": { 143 | "type": "boolean", 144 | "default": false, 145 | "description": "if true, the LanguageServer will not cache the result of parsing source files on disk, so it can be used within readonly directories" 146 | }, 147 | "perl.debugAdapterPort": { 148 | "type": "integer", 149 | "default": 13603, 150 | "description": "port to use for connection between vscode and debug adapter inside Perl::LanguageServer. On a multi user system every user must use a different port." 151 | }, 152 | "perl.debugAdapterPortRange": { 153 | "type": "integer", 154 | "default": 100, 155 | "description": "if debugAdapterPort is in use try ports from debugAdapterPort to debugAdapterPort + debugAdapterPortRange. Default 100." 156 | } 157 | } 158 | }, 159 | "breakpoints": [ 160 | { 161 | "language": "perl" 162 | } 163 | ], 164 | "debuggers": [ 165 | { 166 | "type": "perl", 167 | "label": "Perl Debug", 168 | "languages": [ 169 | "perl" 170 | ], 171 | "program": "./out/dbgforward.js", 172 | "runtime": "node", 173 | "configurationAttributes": { 174 | "launch": { 175 | "required": [ 176 | "program" 177 | ], 178 | "properties": { 179 | "program": { 180 | "type": "string", 181 | "description": "Absolute path to perl file that should be debugged.", 182 | "default": "${workspaceFolder}/${relativeFile}" 183 | }, 184 | "stopOnEntry": { 185 | "type": "boolean", 186 | "description": "Automatically stop after launch.", 187 | "default": true 188 | }, 189 | "args": { 190 | "type": [ "array", "string" ], 191 | "description": "optional, array or string with arguments for perl program.", 192 | "default": null 193 | }, 194 | "env": { 195 | "type": "object", 196 | "description": "optional, object with environment settings.", 197 | "default": null 198 | }, 199 | "cwd": { 200 | "type": "string", 201 | "description": "optional, change working directory before launching the debuggee.", 202 | "default": null 203 | }, 204 | "reloadModules": { 205 | "type": "boolean", 206 | "description": "Automatically reload changed Perl modules while debugging.", 207 | "default": true 208 | }, 209 | "sudoUser": { 210 | "type": "string", 211 | "description": "optional, if set run debug process with sudo -u .", 212 | "default": null 213 | }, 214 | "useTaintForDebug": { 215 | "type": "boolean", 216 | "description": "optional, if set run debug process in taint mode.", 217 | "default": false 218 | }, 219 | "pathMap": { 220 | "type": "array", 221 | "default": null, 222 | "description": "mapping of local to remote paths for this debug session (overwrites global `perl.path_map`)" 223 | }, 224 | "containerCmd": { 225 | "type": "string", 226 | "default": null, 227 | "description": "If set debugger runs inside a container. Options are: 'docker', 'docker-compose', 'podman', 'kubectl'" 228 | }, 229 | "containerArgs": { 230 | "type": "array", 231 | "default": null, 232 | "description": "arguments for containerCmd. Varies depending on containerCmd." 233 | }, 234 | "containerMode": { 235 | "type": "string", 236 | "default": "exec", 237 | "description": "To start a new container, set to 'run', to debug inside an existing container set to 'exec'. Note: kubectl only supports 'exec'" 238 | }, 239 | "containerName": { 240 | "type": "string", 241 | "default": null, 242 | "description": "Image to start or container to exec inside or pod to use" 243 | } 244 | 245 | } 246 | } 247 | }, 248 | "initialConfigurations": [ 249 | { 250 | "type": "perl", 251 | "request": "launch", 252 | "name": "Perl-Debug", 253 | "program": "${workspaceFolder}/${relativeFile}", 254 | "stopOnEntry": true, 255 | "reloadModules": true 256 | } 257 | ], 258 | "configurationSnippets": [ 259 | { 260 | "label": "Perl-Debugger: Start current file", 261 | "description": "A new configuration for launching perl debug program", 262 | "body": { 263 | "type": "perl", 264 | "request": "launch", 265 | "name": "Perl-Debug", 266 | "program": "${workspaceFolder}/${relativeFile}", 267 | "stopOnEntry": true, 268 | "reloadModules": true 269 | } 270 | } 271 | ] 272 | } 273 | ] 274 | }, 275 | "scripts": { 276 | "vscode:prepublish": "npm run compile", 277 | "compile": "tsc -b", 278 | "watch": "tsc -b -w" 279 | }, 280 | "devDependencies": { 281 | "@types/mocha": "^8.2.3", 282 | "@types/node": "^12.20.17", 283 | "@types/vscode": "^1.58.0", 284 | "@typescript-eslint/parser": "^2.4.0", 285 | "eslint": "^6.4.0", 286 | "mocha": "^9.0.3", 287 | "typescript": "^4.3.5" 288 | }, 289 | "dependencies": { 290 | "vscode-languageclient": "^6.1.4" 291 | } 292 | } 293 | -------------------------------------------------------------------------------- /clients/vscode/perl/src/extension.ts: -------------------------------------------------------------------------------- 1 | 2 | 'use strict'; 3 | 4 | import * as vscode from 'vscode'; 5 | import { LanguageClient, LanguageClientOptions, ServerOptions } from 'vscode-languageclient'; 6 | import * as net from 'net'; 7 | 8 | // ------------------------------------------------------------------------------ 9 | // 10 | // ideas for port checking taken from https://github.com/sindresorhus/get-port 11 | // and the typescript port of hakonhagland 12 | // 13 | 14 | function check_available_port (port: number): Promise 15 | { 16 | return new Promise((resolve, reject) => 17 | { 18 | const server = net.createServer(); 19 | server.unref(); 20 | server.on('error', reject); 21 | 22 | server.listen({ host: '127.0.0.1', port: port }, () => 23 | { 24 | //const addr = server.address(); 25 | server.close(() => 26 | { 27 | resolve(port); 28 | }); 29 | }); 30 | }); 31 | } 32 | 33 | // ------------------------------------------------------------------------------ 34 | 35 | async function get_available_port (port: number, port_range: number): Promise 36 | { 37 | for (var i = 0; i < port_range; i++) 38 | { 39 | try 40 | { 41 | console.log('try if port ' + (port + i) + ' is available'); 42 | 43 | return await check_available_port(port + i); 44 | } 45 | catch (error: unknown) 46 | { 47 | let errorCode = error as NodeJS.ErrnoException; 48 | if (errorCode.code === undefined) 49 | { 50 | throw error; 51 | } 52 | else 53 | { 54 | if (!['EADDRNOTAVAIL', 'EINVAL', 'EADDRINUSE'].includes(errorCode.code)) 55 | { 56 | throw error; 57 | } 58 | } 59 | } 60 | } 61 | 62 | return 0 ; 63 | } 64 | 65 | 66 | // ------------------------------------------------------------------------------ 67 | 68 | function resolve_workspaceFolder(path: string, resource? : vscode.Uri): string 69 | { 70 | if (path.includes("${workspaceFolder}")) 71 | { 72 | const ws = vscode.workspace.getWorkspaceFolder(resource as vscode.Uri) ?? vscode.workspace.workspaceFolders?.[0]; 73 | const sub = ws?.uri.fsPath ?? "" ; 74 | return path.replace("${workspaceFolder}", sub); 75 | } 76 | return path; 77 | } 78 | 79 | // ------------------------------------------------------------------------------ 80 | 81 | function buildContainerArgs (containerCmd: string, containerArgs: string[], containerName: string, containerMode: string): string[] 82 | { 83 | //console.log ('buildContainerArgs enter: ' + containerCmd + ' args ' + containerArgs.join (' ') + ' name ' + containerName + ' mode ' + containerMode) ; 84 | 85 | if (containerMode != 'exec') 86 | containerMode = 'run' ; 87 | 88 | if (containerCmd) 89 | { 90 | if (containerArgs.length == 0) 91 | { 92 | if (containerCmd == 'docker') 93 | { 94 | containerArgs.push(containerMode) ; 95 | if (containerMode == 'run') 96 | containerArgs.push('--rm') ; 97 | containerArgs.push('-i', containerName) ; 98 | } 99 | else if (containerCmd == 'podman') 100 | { 101 | containerArgs.push(containerMode) ; 102 | if (containerMode == 'run') 103 | containerArgs.push('--rm') ; 104 | containerArgs.push('-i', containerName) ; 105 | } 106 | else if (containerCmd == 'docker-compose') 107 | { 108 | containerArgs.push(containerMode) ; 109 | if (containerMode == 'run') 110 | containerArgs.push('--rm') ; 111 | containerArgs.push('--no-deps', '-T', containerName) ; 112 | } 113 | else if (containerCmd == 'kubectl') 114 | { 115 | containerArgs.push('exec', containerName, '-i', '--') ; 116 | } 117 | else if (containerCmd == 'devspace') 118 | { 119 | containerArgs.push('--silent ', 'enter') ; 120 | if (containerName) 121 | containerArgs.push('-c', containerName) ; 122 | containerArgs.push('--') ; 123 | } 124 | } 125 | } 126 | //console.log ('buildContainerArgs exit: ' + containerCmd + ' args ' + containerArgs.join (' ') + ' name ' + containerName + ' mode ' + containerMode) ; 127 | 128 | return containerArgs ; 129 | } 130 | 131 | // ------------------------------------------------------------------------------ 132 | 133 | export async function activate(context: vscode.ExtensionContext) 134 | { 135 | let config = vscode.workspace.getConfiguration('perl') ; 136 | if (!config.get('enable')) 137 | { 138 | console.log('extension "perl" is disabled'); 139 | return ; 140 | } 141 | 142 | console.log('extension "perl" is now active'); 143 | 144 | let env : any = {} ; 145 | if (!config.get('disablePassEnv')) 146 | { 147 | var k ; 148 | for (k in process.env) 149 | { 150 | env[k] = process.env[k] ; 151 | console.log('env: ' + k + ' = ' + env[k] ) ; 152 | } 153 | } 154 | 155 | 156 | let resource = vscode.window.activeTextEditor?.document.uri ; 157 | 158 | let containerCmd : string = config.get('containerCmd') || '' ; 159 | let containerArgs : string[] = config.get('containerArgs') || [] ; 160 | let containerName : string = config.get('containerName') || '' ; 161 | let containerMode : string = config.get('containerMode') || 'exec' ; 162 | 163 | let debug_adapter_port : number = config.get('debugAdapterPort') || 13603 ; 164 | let debug_adapter_port_range : number = config.get('debugAdapterPortRange') || 100 ; 165 | if (!containerCmd) 166 | { 167 | debug_adapter_port = await get_available_port (debug_adapter_port, debug_adapter_port_range) ; 168 | console.log('use ' + debug_adapter_port + ' as debug adapter port'); 169 | } 170 | 171 | let perlCmd : string = resolve_workspaceFolder((config.get('perlCmd') || 'perl'), resource); 172 | let perlArgs : string[] = config.get('perlArgs') || [] ; 173 | let perlInc : string[] = config.get('perlInc') || [] ; 174 | let perlIncOpt : string[] = perlInc.map((dir: string) => "-I" + resolve_workspaceFolder(dir, resource)) ; 175 | let addenv : any = config.get('env') || {} ; 176 | var k ; 177 | for (k in addenv) 178 | { 179 | env[k] = addenv[k] ; 180 | console.log('addenv: ' + k + ' = ' + env[k] ) ; 181 | } 182 | let logFile : string = config.get('logFile') || '' ; 183 | let logLevel : number = config.get('logLevel') || 0 ; 184 | let client_version : string = "2.6.2" ; 185 | let perlArgsOpt : string[] = [...perlIncOpt, 186 | ...perlArgs, 187 | '-MPerl::LanguageServer', '-e', 'Perl::LanguageServer::run', '--', 188 | '--port', debug_adapter_port.toString(), 189 | '--log-level', logLevel.toString(), 190 | '--log-file', logFile, 191 | '--version', client_version] ; 192 | 193 | let sshPortOption = '-p' ; 194 | let sshCmd : string = config.get('sshCmd') || '' ; 195 | if (!sshCmd) 196 | { 197 | if (/^win/.test(process.platform)) 198 | { 199 | sshCmd = 'plink' ; 200 | sshPortOption = '-P' ; 201 | } 202 | else 203 | { 204 | sshCmd = 'ssh' ; 205 | } 206 | } 207 | let sshArgs:string[] = config.get('sshArgs') || [] ; 208 | let sshUser:string = config.get('sshUser') || '' ; 209 | let sshAddr:string = config.get('sshAddr') || ''; 210 | let sshPort:string = config.get('sshPort') || '' ; 211 | 212 | let containerArgsOpt : string[] = buildContainerArgs (containerCmd, containerArgs, containerName, containerMode) ; 213 | 214 | var serverCmd : string ; 215 | var serverArgs : string[] ; 216 | 217 | if (sshAddr && sshUser) 218 | { 219 | serverCmd = sshCmd ; 220 | if (sshPort) 221 | { 222 | sshArgs.push(sshPortOption, sshPort) ; 223 | } 224 | sshArgs.push('-l', sshUser, sshAddr, '-L', debug_adapter_port + ':127.0.0.1:' + debug_adapter_port) ; 225 | if (containerCmd) 226 | { 227 | sshArgs.push(containerCmd) ; 228 | sshArgs = sshArgs.concat(containerArgsOpt) ; 229 | } 230 | sshArgs.push(perlCmd) ; 231 | serverArgs = sshArgs.concat(perlArgsOpt) ; 232 | } 233 | else 234 | { 235 | if (containerCmd) 236 | { 237 | serverCmd = containerCmd ; 238 | serverArgs = containerArgsOpt.concat(perlCmd, perlArgsOpt) ; 239 | } 240 | else 241 | { 242 | serverCmd = perlCmd ; 243 | serverArgs = perlArgsOpt ; 244 | } 245 | } 246 | 247 | vscode.debug.registerDebugAdapterDescriptorFactory('perl', 248 | { 249 | createDebugAdapterDescriptor(session: vscode.DebugSession, executable: vscode.DebugAdapterExecutable) 250 | { 251 | let cfg = session.configuration ; 252 | 253 | let debugContainerCmd : string = cfg.containerCmd || containerCmd ; 254 | let debugContainerArgs : string[] = cfg.containerArgs || containerArgs ; 255 | let debugContainerName : string = cfg.containerName || containerName ; 256 | let debugContainerMode : string = cfg.containerMode || containerMode ; 257 | 258 | let debugContainerArgsOpt : string[] = buildContainerArgs (debugContainerCmd, debugContainerArgs, debugContainerName, debugContainerMode) ; 259 | 260 | if (debugContainerCmd) 261 | { 262 | var daCmd : string ; 263 | var daArgs : string[] ; 264 | 265 | if (containerCmd) 266 | { 267 | // LanguageServer already running inside container 268 | daArgs = debugContainerArgsOpt.concat ([perlCmd, ...perlIncOpt, 269 | ...perlArgs, 270 | '-MPerl::LanguageServer::DebuggerBridge', '-e', 'Perl::LanguageServer::DebuggerBridge::run', 271 | debug_adapter_port.toString()]) ; 272 | } 273 | else 274 | { 275 | // LanguageServer not running inside container 276 | daArgs = debugContainerArgsOpt.concat ([perlCmd, ...perlArgsOpt]) ; 277 | } 278 | daCmd = debugContainerCmd ; 279 | console.log ('start perl debug adapter in container: ' + daCmd + ' ' + daArgs.join (' ')) ; 280 | return new vscode.DebugAdapterExecutable(daCmd, daArgs, { env: env }) ; 281 | } 282 | else 283 | { 284 | // TODO: use SocketDebugAdapter 285 | //return new vscode.SocketDebugAdapter () ; 286 | 287 | executable.args.push (debug_adapter_port.toString()) ; 288 | } 289 | console.log ('start perl debug adapter: ' + executable.command + ' ' + executable.args.join (' ')) ; 290 | return executable ; 291 | } 292 | }); 293 | 294 | vscode.debug.registerDebugConfigurationProvider('perl', 295 | { 296 | resolveDebugConfiguration(folder: vscode.WorkspaceFolder | undefined, config: vscode.DebugConfiguration, token?: vscode.CancellationToken): vscode.ProviderResult 297 | { 298 | console.log('start perl debug resolveDebugConfiguration'); 299 | 300 | if (!config.request) 301 | { 302 | console.log('config perl debug resolveDebugConfiguration'); 303 | var dbgconfig = 304 | { 305 | type: "perl", 306 | request: "launch", 307 | name: "Perl-Debug", 308 | program: "${workspaceFolder}/${relativeFile}", 309 | stopOnEntry: true, 310 | reloadModules: true 311 | } ; 312 | 313 | return dbgconfig ; 314 | } 315 | 316 | return config ; 317 | } 318 | }, vscode.DebugConfigurationProviderTriggerKind.Dynamic); 319 | 320 | 321 | console.log('cmd: ' + serverCmd + ' args: ' + serverArgs.join (' ')); 322 | 323 | let debugArgs = serverArgs.concat(["--debug"]) ; 324 | let serverOptions: ServerOptions = { 325 | run: { command: serverCmd, args: serverArgs, options: { env: env } }, 326 | debug: { command: serverCmd, args: debugArgs, options: { env: env } }, 327 | } ; 328 | 329 | // Options to control the language client 330 | let clientOptions: LanguageClientOptions = { 331 | // Register the server for plain text documents 332 | documentSelector: [{scheme: 'file', language: 'perl'}], 333 | synchronize: { 334 | // Synchronize the setting section 'perl_lang' to the server 335 | configurationSection: 'perl', 336 | } 337 | } ; 338 | 339 | // Create the language client and start the client. 340 | let disposable = new LanguageClient('perl', 'Perl Language Server', serverOptions, clientOptions).start(); 341 | 342 | // Push the disposable to the context's subscriptions so that the 343 | // client can be deactivated on extension deactivation 344 | context.subscriptions.push(disposable); 345 | } 346 | 347 | // this method is called when your extension is deactivated 348 | //export function deactivate() { 349 | //} 350 | 351 | -------------------------------------------------------------------------------- /clients/vscode/perl/tsconfig.json: -------------------------------------------------------------------------------- 1 | { 2 | "compilerOptions": { 3 | "module": "commonjs", 4 | "target": "es6", 5 | "outDir": "out", 6 | "lib": [ 7 | "es6" 8 | ], 9 | "sourceMap": true, 10 | "rootDir": "src", 11 | /* Strict Type-Checking Option */ 12 | "strict": true, /* enable all strict type-checking options */ 13 | /* Additional Checks */ 14 | "noUnusedLocals": true /* Report errors on unused locals. */ 15 | // "noImplicitReturns": true, /* Report error when not all code paths in function return a value. */ 16 | // "noFallthroughCasesInSwitch": true, /* Report errors for fallthrough cases in switch statement. */ 17 | // "noUnusedParameters": true, /* Report errors on unused parameters. */ 18 | }, 19 | "exclude": [ 20 | "node_modules", 21 | ".vscode-test" 22 | ] 23 | } -------------------------------------------------------------------------------- /clients/vscode/perl/tslint.json: -------------------------------------------------------------------------------- 1 | { 2 | "rules": { 3 | "no-string-throw": true, 4 | "no-unused-expression": true, 5 | "no-duplicate-variable": true, 6 | "curly": true, 7 | "class-name": true, 8 | "semicolon": [ 9 | true, 10 | "always" 11 | ], 12 | "triple-equals": true 13 | }, 14 | "defaultSeverity": "warning" 15 | } -------------------------------------------------------------------------------- /debian/changelog: -------------------------------------------------------------------------------- 1 | libperl-languageserver-perl (2.3.0) unstable; urgency=low 2 | 3 | * Initial release. 4 | 5 | -- grichter Wed, 20 Apr 2022 06:35:34 +0200 6 | -------------------------------------------------------------------------------- /debian/control: -------------------------------------------------------------------------------- 1 | Source: libperl-languageserver-perl 2 | Maintainer: grichter 3 | Section: perl 4 | Priority: optional 5 | Build-Depends: debhelper-compat (= 13) 6 | Build-Depends-Indep: libanyevent-aio-perl , 7 | libanyevent-perl , 8 | libclass-refresh-perl , 9 | libcompiler-lexer-perl , 10 | libcoro-perl , 11 | libdata-dump-perl , 12 | libhash-safekeys-perl , 13 | libio-aio-perl , 14 | libjson-perl , 15 | libmoose-perl , 16 | libpadwalker-perl , 17 | libscalar-list-utils-perl , 18 | libtest-simple-perl , 19 | perl 20 | Standards-Version: 4.5.1 21 | Homepage: https://metacpan.org/release/Perl-LanguageServer 22 | Rules-Requires-Root: no 23 | 24 | Package: libperl-languageserver-perl 25 | Architecture: all 26 | Depends: ${misc:Depends}, 27 | ${perl:Depends}, 28 | libanyevent-aio-perl, 29 | libanyevent-perl, 30 | libclass-refresh-perl, 31 | libcompiler-lexer-perl, 32 | libcoro-perl, 33 | libdata-dump-perl, 34 | libhash-safekeys-perl, 35 | libio-aio-perl, 36 | libjson-perl, 37 | libmoose-perl, 38 | libpadwalker-perl, 39 | libscalar-list-utils-perl 40 | Description: Language Server and Debug Protocol Adapter for Perl 41 | It implements the Language Server Protocol which provides 42 | syntax-checking, symbol search, etc. Perl to various editors, for 43 | example Visual Studio Code or Atom. 44 | -------------------------------------------------------------------------------- /debian/copyright: -------------------------------------------------------------------------------- 1 | Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ 2 | Source: https://metacpan.org/release/Perl-LanguageServer 3 | Upstream-Contact: grichter 4 | Upstream-Name: Perl-LanguageServer 5 | 6 | Files: * 7 | Copyright: 2018-2022, grichter 8 | License: Artistic-2.0 9 | 10 | Files: debian/* 11 | Copyright: 2022, grichter 12 | License: Artistic or Artistic-2.0 or GPL-1+ 13 | 14 | License: Artistic 15 | This program is free software; you can redistribute it and/or modify 16 | it under the terms of the Artistic License, which comes with Perl. 17 | . 18 | On Debian systems, the complete text of the Artistic License can be 19 | found in `/usr/share/common-licenses/Artistic'. 20 | 21 | License: Artistic-2.0 22 | The Artistic License 2.0 23 | . 24 | Copyright (c) 2000-2006, The Perl Foundation. 25 | . 26 | Everyone is permitted to copy and distribute verbatim copies 27 | of this license document, but changing it is not allowed. 28 | . 29 | Preamble 30 | . 31 | This license establishes the terms under which a given free software 32 | Package may be copied, modified, distributed, and/or redistributed. 33 | The intent is that the Copyright Holder maintains some artistic 34 | control over the development of that Package while still keeping the 35 | Package available as open source and free software. 36 | . 37 | You are always permitted to make arrangements wholly outside of this 38 | license directly with the Copyright Holder of a given Package. If the 39 | terms of this license do not permit the full use that you propose to 40 | make of the Package, you should contact the Copyright Holder and seek 41 | a different licensing arrangement. 42 | . 43 | Definitions 44 | . 45 | "Copyright Holder" means the individual(s) or organization(s) 46 | named in the copyright notice for the entire Package. 47 | . 48 | "Contributor" means any party that has contributed code or other 49 | material to the Package, in accordance with the Copyright Holder's 50 | procedures. 51 | . 52 | "You" and "your" means any person who would like to copy, 53 | distribute, or modify the Package. 54 | . 55 | "Package" means the collection of files distributed by the 56 | Copyright Holder, and derivatives of that collection and/or of 57 | those files. A given Package may consist of either the Standard 58 | Version, or a Modified Version. 59 | . 60 | "Distribute" means providing a copy of the Package or making it 61 | accessible to anyone else, or in the case of a company or 62 | organization, to others outside of your company or organization. 63 | . 64 | "Distributor Fee" means any fee that you charge for Distributing 65 | this Package or providing support for this Package to another 66 | party. It does not mean licensing fees. 67 | . 68 | "Standard Version" refers to the Package if it has not been 69 | modified, or has been modified only in ways explicitly requested 70 | by the Copyright Holder. 71 | . 72 | "Modified Version" means the Package, if it has been changed, and 73 | such changes were not explicitly requested by the Copyright 74 | Holder. 75 | . 76 | "Original License" means this Artistic License as Distributed with 77 | the Standard Version of the Package, in its current version or as 78 | it may be modified by The Perl Foundation in the future. 79 | . 80 | "Source" form means the source code, documentation source, and 81 | configuration files for the Package. 82 | . 83 | "Compiled" form means the compiled bytecode, object code, binary, 84 | or any other form resulting from mechanical transformation or 85 | translation of the Source form. 86 | . 87 | . 88 | Permission for Use and Modification Without Distribution 89 | . 90 | (1) You are permitted to use the Standard Version and create and use 91 | Modified Versions for any purpose without restriction, provided that 92 | you do not Distribute the Modified Version. 93 | . 94 | . 95 | Permissions for Redistribution of the Standard Version 96 | . 97 | (2) You may Distribute verbatim copies of the Source form of the 98 | Standard Version of this Package in any medium without restriction, 99 | either gratis or for a Distributor Fee, provided that you duplicate 100 | all of the original copyright notices and associated disclaimers. At 101 | your discretion, such verbatim copies may or may not include a 102 | Compiled form of the Package. 103 | . 104 | (3) You may apply any bug fixes, portability changes, and other 105 | modifications made available from the Copyright Holder. The resulting 106 | Package will still be considered the Standard Version, and as such 107 | will be subject to the Original License. 108 | . 109 | . 110 | Distribution of Modified Versions of the Package as Source 111 | . 112 | (4) You may Distribute your Modified Version as Source (either gratis 113 | or for a Distributor Fee, and with or without a Compiled form of the 114 | Modified Version) provided that you clearly document how it differs 115 | from the Standard Version, including, but not limited to, documenting 116 | any non-standard features, executables, or modules, and provided that 117 | you do at least ONE of the following: 118 | . 119 | (a) make the Modified Version available to the Copyright Holder 120 | of the Standard Version, under the Original License, so that the 121 | Copyright Holder may include your modifications in the Standard 122 | Version. 123 | . 124 | (b) ensure that installation of your Modified Version does not 125 | prevent the user installing or running the Standard Version. In 126 | addition, the Modified Version must bear a name that is different 127 | from the name of the Standard Version. 128 | . 129 | (c) allow anyone who receives a copy of the Modified Version to 130 | make the Source form of the Modified Version available to others 131 | under 132 | . 133 | (i) the Original License or 134 | . 135 | (ii) a license that permits the licensee to freely copy, 136 | modify and redistribute the Modified Version using the same 137 | licensing terms that apply to the copy that the licensee 138 | received, and requires that the Source form of the Modified 139 | Version, and of any works derived from it, be made freely 140 | available in that license fees are prohibited but Distributor 141 | Fees are allowed. 142 | . 143 | . 144 | Distribution of Compiled Forms of the Standard Version 145 | or Modified Versions without the Source 146 | . 147 | (5) You may Distribute Compiled forms of the Standard Version without 148 | the Source, provided that you include complete instructions on how to 149 | get the Source of the Standard Version. Such instructions must be 150 | valid at the time of your distribution. If these instructions, at any 151 | time while you are carrying out such distribution, become invalid, you 152 | must provide new instructions on demand or cease further distribution. 153 | If you provide valid instructions or cease distribution within thirty 154 | days after you become aware that the instructions are invalid, then 155 | you do not forfeit any of your rights under this license. 156 | . 157 | (6) You may Distribute a Modified Version in Compiled form without 158 | the Source, provided that you comply with Section 4 with respect to 159 | the Source of the Modified Version. 160 | . 161 | . 162 | Aggregating or Linking the Package 163 | . 164 | (7) You may aggregate the Package (either the Standard Version or 165 | Modified Version) with other packages and Distribute the resulting 166 | aggregation provided that you do not charge a licensing fee for the 167 | Package. Distributor Fees are permitted, and licensing fees for other 168 | components in the aggregation are permitted. The terms of this license 169 | apply to the use and Distribution of the Standard or Modified Versions 170 | as included in the aggregation. 171 | . 172 | (8) You are permitted to link Modified and Standard Versions with 173 | other works, to embed the Package in a larger work of your own, or to 174 | build stand-alone binary or bytecode versions of applications that 175 | include the Package, and Distribute the result without restriction, 176 | provided the result does not expose a direct interface to the Package. 177 | . 178 | . 179 | Items That are Not Considered Part of a Modified Version 180 | . 181 | (9) Works (including, but not limited to, modules and scripts) that 182 | merely extend or make use of the Package, do not, by themselves, cause 183 | the Package to be a Modified Version. In addition, such works are not 184 | considered parts of the Package itself, and are not subject to the 185 | terms of this license. 186 | . 187 | . 188 | General Provisions 189 | . 190 | (10) Any use, modification, and distribution of the Standard or 191 | Modified Versions is governed by this Artistic License. By using, 192 | modifying or distributing the Package, you accept this license. Do not 193 | use, modify, or distribute the Package, if you do not accept this 194 | license. 195 | . 196 | (11) If your Modified Version has been derived from a Modified 197 | Version made by someone other than you, you are nevertheless required 198 | to ensure that your Modified Version complies with the requirements of 199 | this license. 200 | . 201 | (12) This license does not grant you the right to use any trademark, 202 | service mark, tradename, or logo of the Copyright Holder. 203 | . 204 | (13) This license includes the non-exclusive, worldwide, 205 | free-of-charge patent license to make, have made, use, offer to sell, 206 | sell, import and otherwise transfer the Package with respect to any 207 | patent claims licensable by the Copyright Holder that are necessarily 208 | infringed by the Package. If you institute patent litigation 209 | (including a cross-claim or counterclaim) against any party alleging 210 | that the Package constitutes direct or contributory patent 211 | infringement, then this Artistic License to you shall terminate on the 212 | date that such litigation is filed. 213 | . 214 | (14) Disclaimer of Warranty: 215 | THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS 216 | IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED 217 | WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR 218 | NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL 219 | LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL 220 | BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL 221 | DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF 222 | ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 223 | 224 | License: GPL-1+ 225 | This program is free software; you can redistribute it and/or modify 226 | it under the terms of the GNU General Public License as published by 227 | the Free Software Foundation; either version 1, or (at your option) 228 | any later version. 229 | . 230 | On Debian systems, the complete text of version 1 of the GNU General 231 | Public License can be found in `/usr/share/common-licenses/GPL-1'. 232 | -------------------------------------------------------------------------------- /debian/rules: -------------------------------------------------------------------------------- 1 | #!/usr/bin/make -f 2 | 3 | %: 4 | dh $@ 5 | -------------------------------------------------------------------------------- /docs/Perl-LanguageServer und Debugger für Visual Studio Code u.a. Editoren - Perl Workshop 2020.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/richterger/Perl-LanguageServer/HEAD/docs/Perl-LanguageServer und Debugger für Visual Studio Code u.a. Editoren - Perl Workshop 2020.pdf -------------------------------------------------------------------------------- /lib/Perl/LanguageServer/DebuggerBridge.pm: -------------------------------------------------------------------------------- 1 | package Perl::LanguageServer::DebuggerBridge ; 2 | 3 | use 5.006; 4 | use strict; 5 | use IO::Socket ; 6 | use IO::Select; 7 | 8 | no warnings 'uninitialized' ; 9 | 10 | sub run 11 | { 12 | my $socket ; 13 | my $proto = getprotobyname ('tcp') ; 14 | my $ip = '127.0.0.1' ; 15 | my $port = $ARGV[0] || 13603 ; 16 | socket ($socket, PF_INET, SOCK_STREAM, $proto) 17 | or die "Can't create a socket $!\n" ; 18 | connect ($socket, pack_sockaddr_in ($port, inet_aton ($ip))) 19 | or die "Can't connect to $ip:$port $!\n" ; 20 | my $stdin = \*STDIN ; 21 | my $s = IO::Select->new(); 22 | $s->add($stdin); 23 | $s->add($socket); 24 | 25 | my $timeout = 0 ; 26 | my @ready ; 27 | while (@ready = $s->can_read()) 28 | { 29 | while (my $fh = shift @ready) 30 | { 31 | if ($fh == $stdin) 32 | { 33 | my $data ; 34 | exit if (sysread ($fh, $data, 16384) <= 0) ; 35 | syswrite ($socket, $data) ; 36 | } 37 | elsif ($fh == $socket) 38 | { 39 | my $data ; 40 | exit if (sysread ($fh, $data, 16384) <= 0) ; 41 | syswrite (\*STDOUT, $data) ; 42 | } 43 | } 44 | } 45 | } 46 | 47 | 1 ; -------------------------------------------------------------------------------- /lib/Perl/LanguageServer/DebuggerProcess.pm: -------------------------------------------------------------------------------- 1 | package Perl::LanguageServer::DebuggerProcess ; 2 | 3 | use 5.006; 4 | use strict; 5 | use Moose ; 6 | 7 | use Encode::Locale; 8 | use Encode; 9 | use File::Basename ; 10 | use Coro ; 11 | use Coro::AIO ; 12 | use Data::Dump qw{dump} ; 13 | 14 | with 'Perl::LanguageServer::IO' ; 15 | 16 | no warnings 'uninitialized' ; 17 | 18 | our $session_cnt = 1 ; 19 | 20 | # --------------------------------------------------------------------------- 21 | 22 | has 'program' => 23 | ( 24 | isa => 'Str', 25 | is => 'ro' 26 | ) ; 27 | 28 | has 'args' => 29 | ( 30 | isa => 'ArrayRef | Str', 31 | is => 'ro', 32 | default => sub { [] }, 33 | ) ; 34 | 35 | has 'env' => 36 | ( 37 | isa => 'HashRef', 38 | is => 'ro', 39 | default => sub { {} }, 40 | ) ; 41 | 42 | has 'cwd' => 43 | ( 44 | isa => 'Maybe[Str]', 45 | is => 'ro', 46 | ) ; 47 | 48 | has 'sudo_user' => 49 | ( 50 | isa => 'Maybe[Str]', 51 | is => 'ro', 52 | ) ; 53 | 54 | has 'use_taint_for_debug' => 55 | ( 56 | isa => 'Bool', 57 | is => 'rw' 58 | ) ; 59 | 60 | has 'path_map' => 61 | ( 62 | isa => 'Maybe[ArrayRef]', 63 | is => 'rw' 64 | ) ; 65 | 66 | has 'stop_on_entry' => 67 | ( 68 | isa => 'Bool', 69 | is => 'ro' 70 | ) ; 71 | 72 | has 'reload_modules' => 73 | ( 74 | isa => 'Bool', 75 | is => 'ro' 76 | ) ; 77 | 78 | has 'session_id' => 79 | ( 80 | isa => 'Str', 81 | is => 'ro' 82 | ) ; 83 | 84 | has 'type' => 85 | ( 86 | isa => 'Str', 87 | is => 'ro' 88 | ) ; 89 | 90 | has 'debug_adapter' => 91 | ( 92 | isa => 'Perl::LanguageServer', 93 | is => 'rw', 94 | weak_ref => 1, 95 | ) ; 96 | 97 | has 'pid' => 98 | ( 99 | isa => 'Int', 100 | is => 'rw' 101 | ) ; 102 | 103 | 104 | # --------------------------------------------------------------------------- 105 | 106 | sub BUILDARGS 107 | { 108 | my ($class, $args) = @_ ; 109 | 110 | $args -> {env} = { @{$args -> {env}} } if (exists $args -> {env} && ref ($args -> {env}) eq 'ARRAY') ; 111 | $args -> {reload_modules} = delete $args -> {reloadModules}?1:0 ; 112 | $args -> {stop_on_entry} = delete $args -> {stopOnEntry}?1:0 ; 113 | $args -> {session_id} = delete $args -> {__sessionId} || $session_cnt ; 114 | $args -> {sudo_user} = delete $args -> {sudoUser} ; 115 | $args -> {use_taint_for_debug} = delete $args -> {useTaintForDebug} ; 116 | my $map = delete $args -> {pathMap} ; 117 | if ($map) 118 | { 119 | my $fn ; 120 | foreach (@$map) 121 | { 122 | $fn = $_ -> [0] ; 123 | $fn =~ s/^file:// ; 124 | $fn =~ s/^\/\/\//\// ; 125 | $_ -> [2] ||= $fn ; 126 | $fn = $_ -> [1] ; 127 | $fn =~ s/^file:// ; 128 | $fn =~ s/^\/\/\//\// ; 129 | $_ -> [3] ||= $fn ; 130 | } 131 | $args -> {path_map} = $map ; 132 | } 133 | 134 | $session_cnt++ ; 135 | 136 | return $args ; 137 | } 138 | 139 | # --------------------------------------------------------------------------- 140 | 141 | sub logger 142 | { 143 | my $self = shift ; 144 | 145 | $self -> debug_adapter -> logger (@_) ; 146 | } 147 | 148 | # --------------------------------------------------------------------------- 149 | 150 | sub file_server2client 151 | { 152 | my ($self, $workspace, $fn) = @_ ; 153 | 154 | return $workspace -> file_server2client ($fn, $self -> path_map) ; 155 | } 156 | 157 | # --------------------------------------------------------------------------- 158 | 159 | sub file_client2server 160 | { 161 | my ($self, $workspace, $fn) = @_ ; 162 | 163 | return $workspace -> file_client2server ($fn, $self -> path_map) ; 164 | } 165 | 166 | # --------------------------------------------------------------------------- 167 | 168 | sub add_path_mapping 169 | { 170 | my ($self, $fn_server, $fn_client) = @_ ; 171 | my $map = $self -> path_map ; 172 | $map = $self -> path_map ([]) if (!$map) ; 173 | 174 | 175 | foreach my $m (@$map) 176 | { 177 | #print STDERR "add file_server2client $m->[2] -> $m->[3]\n" ; 178 | return if ($fn_server eq $m->[2]) ; 179 | } 180 | 181 | unshift @$map, ['file://' . $fn_server, 'file://' . $fn_client, $fn_server, $fn_client] ; 182 | return ; 183 | } 184 | 185 | # --------------------------------------------------------------------------- 186 | 187 | sub send_event 188 | { 189 | my ($self, $event, $body) = @_ ; 190 | 191 | $self -> debug_adapter -> send_event ($event, $body) ; 192 | } 193 | 194 | # --------------------------------------------------------------------------- 195 | 196 | sub launch 197 | { 198 | my ($self, $workspace, $cmd) = @_ ; 199 | 200 | my $fn = $self -> file_client2server ($workspace, $self -> program) ; 201 | my $pid ; 202 | { 203 | local %ENV = %ENV ; 204 | my @sudoargs ; 205 | if ($self->sudo_user) 206 | { 207 | push @sudoargs, "sudo", "-u", $self->sudo_user ; 208 | } 209 | foreach (keys %{$self -> env}) 210 | { 211 | $ENV{$_} = $self -> env -> {$_} ; 212 | push @sudoargs, "$_=" . $self -> env -> {$_} if $self->sudo_user; 213 | } 214 | 215 | my $cwd ; 216 | if ($self -> cwd) 217 | { 218 | my $dir = $self -> cwd ; 219 | $dir =~ s/'//g ; 220 | $cwd = " chdir '$dir'; " ; 221 | } 222 | 223 | my $inc = $workspace -> perlinc ; 224 | my @inc ; 225 | @inc = map { ('-I', $_)} @$inc if ($inc) ; 226 | 227 | $ENV{PLSDI_REMOTE} = '127.0.0.1:' . $self -> debug_adapter -> listen_port ; 228 | $ENV{PLSDI_OPTIONS} = $self -> reload_modules?'reload_modules':'' ; 229 | $ENV{PERL5DB} = 'BEGIN { $| = 1 ; ' . $cwd . 'require Perl::LanguageServer::DebuggerInterface; DB::DB(); }' ; 230 | $ENV{PLSDI_SESSION}= $self -> session_id ; 231 | if ($self->sudo_user) 232 | { 233 | push @sudoargs, "PLSDI_REMOTE=$ENV{PLSDI_REMOTE}" ; 234 | push @sudoargs, "PLSDI_OPTIONS=$ENV{PLSDI_OPTIONS}" ; 235 | push @sudoargs, "PERL5DB=$ENV{PERL5DB}" ; 236 | push @sudoargs, "PLSDI_SESSION=$ENV{PLSDI_SESSION}" ; 237 | } 238 | if ($self->use_taint_for_debug) 239 | { 240 | push @inc, "-T" ; 241 | } 242 | 243 | if (ref $self -> args) # ref is array 244 | { 245 | $pid = $self -> run_async ([@sudoargs, $cmd, @inc, '-d', $fn, @{$self -> args}]) ; 246 | } 247 | else # no ref is string 248 | { 249 | $pid = $self -> run_async (join (' ', @sudoargs, $cmd, @inc, '-d', $fn, $self -> args)) ; 250 | } 251 | } 252 | 253 | $self -> pid ($pid) ; 254 | $self -> send_event ('process', 255 | { 256 | name => $self -> program, 257 | systemProcessId => $pid, 258 | isLocalProcess => JSON::true(), 259 | startMethod => 'launch', 260 | }) ; 261 | 262 | return ; 263 | } 264 | 265 | # --------------------------------------------------------------------------- 266 | 267 | sub signal 268 | { 269 | my ($self, $signal) = @_ ; 270 | 271 | return if (!$self -> pid) ; 272 | 273 | $self -> logger ("Send signal $signal to debuggee\n") ; 274 | 275 | kill $signal, $self -> pid ; 276 | } 277 | 278 | # --------------------------------------------------------------------------- 279 | 280 | sub on_stdout 281 | { 282 | my ($self, $data) = @_ ; 283 | 284 | foreach my $line (split /\r?\n/, $data) 285 | { 286 | $line = decode(locale => $line); 287 | $self -> send_event ('output', { category => 'stdout', output => $line . "\r\n" }) ; 288 | } 289 | } 290 | 291 | # --------------------------------------------------------------------------- 292 | 293 | sub on_stderr 294 | { 295 | my ($self, $data) = @_ ; 296 | 297 | foreach my $line (split /\r?\n/, $data) 298 | { 299 | $line = decode(locale => $line); 300 | $self -> send_event ('output', { category => 'stderr', output => $line . "\r\n" }) ; 301 | } 302 | } 303 | 304 | # --------------------------------------------------------------------------- 305 | 306 | sub on_exit 307 | { 308 | my ($self, $data) = @_ ; 309 | 310 | $self -> send_event ('terminated') ; 311 | $self -> send_event ('exited', { exitCode => ($data>>8)&0xff }) ; 312 | } 313 | 314 | # --------------------------------------------------------------------------- 315 | 316 | 1 ; 317 | 318 | -------------------------------------------------------------------------------- /lib/Perl/LanguageServer/DevTool.pm: -------------------------------------------------------------------------------- 1 | package Perl::LanguageServer::DevTool ; 2 | 3 | use 5.006; 4 | use strict; 5 | use Moose ; 6 | 7 | use File::Basename ; 8 | use Coro ; 9 | use Coro::AIO ; 10 | use Data::Dump qw{dump} ; 11 | 12 | no warnings 'uninitialized' ; 13 | 14 | # --------------------------------------------------------------------------- 15 | 16 | has 'config' => 17 | ( 18 | isa => 'HashRef', 19 | is => 'ro' 20 | ) ; 21 | 22 | # --------------------------------------------------------------------------- 23 | 24 | 1 ; 25 | -------------------------------------------------------------------------------- /lib/Perl/LanguageServer/IO.pm: -------------------------------------------------------------------------------- 1 | package Perl::LanguageServer::IO ; 2 | 3 | use Moose::Role ; 4 | 5 | use Coro ; 6 | use Coro::AIO ; 7 | use Data::Dump qw{dump} ; 8 | 9 | no warnings 'uninitialized' ; 10 | 11 | has 'out_fh' => 12 | ( 13 | is => 'rw', 14 | #isa => 'Int', 15 | ) ; 16 | 17 | has 'in_fh' => 18 | ( 19 | is => 'rw', 20 | #isa => 'Int', 21 | ) ; 22 | 23 | # --------------------------------------------------------------------------- 24 | 25 | our $windows= ($^O =~ /Win/)?1:0 ; 26 | 27 | # --------------------------------------------------------------------------- 28 | 29 | sub _read 30 | { 31 | my ($self, $data, $length, $dataoffset, $fh, $readline) = @_ ; 32 | 33 | $fh ||= $self -> in_fh ; 34 | 35 | if (ref ($fh) =~ /^Coro::Handle/) 36 | { 37 | if ($readline) 38 | { 39 | $$data = $fh -> readline ; 40 | return length ($$data) ; 41 | } 42 | return $fh -> sysread ($$data, $length, $dataoffset) ; 43 | } 44 | if (!$windows || !ref $fh) 45 | { 46 | return aio_read ($fh, undef, $length, $$data, $dataoffset) ; 47 | } 48 | 49 | my $timeout = 0.01 ; 50 | 51 | my $s = IO::Select -> new (); 52 | $s -> add($fh) ; 53 | my @ready ; 54 | while (!(@ready = $s -> can_read (0))) 55 | { 56 | Coro::AnyEvent::sleep ($timeout) ; 57 | } 58 | $length = length ($$data) if (!defined ($length)) ; 59 | return sysread ($fh, $$data, $length, $dataoffset) ; 60 | } 61 | 62 | # --------------------------------------------------------------------------- 63 | 64 | sub _write 65 | { 66 | my ($self, $data, $length, $dataoffset) = @_ ; 67 | 68 | my $fh = $self -> out_fh ; 69 | if (ref ($fh) =~ /^Coro::Handle/) 70 | { 71 | return $fh -> syswrite ($data, $length, $dataoffset) ; 72 | } 73 | 74 | if (!$windows || !ref $fh) 75 | { 76 | return aio_write ($fh, undef, $length, $data, $dataoffset) ; 77 | } 78 | 79 | $length = length ($data) if (!defined ($length)) ; 80 | return syswrite ($fh, $data, $length, $dataoffset) ; 81 | } 82 | 83 | # --------------------------------------------------------------------------- 84 | 85 | sub run_async 86 | { 87 | my ($self, $cmd, $on_stdout, $on_stderr, $on_exit) = @_ ; 88 | 89 | $on_stdout ||= 'on_stdout' ; 90 | $on_stderr ||= 'on_stderr' ; 91 | $on_exit ||= 'on_exit' ; 92 | 93 | my($wtr, $rdr, $err); 94 | 95 | if ( ref($cmd) ) 96 | { 97 | $self -> logger ("start @$cmd\n") ; 98 | } else 99 | { 100 | $self -> logger ("start $cmd\n") ; 101 | } 102 | 103 | require IPC::Open3 ; 104 | require Symbol ; 105 | $err = Symbol::gensym () ; 106 | my $pid; 107 | if ( ref($cmd) ) 108 | { 109 | $pid = IPC::Open3::open3($wtr, $rdr, $err, @$cmd) or die "Cannot run @$cmd" ; 110 | } else 111 | { 112 | $pid = IPC::Open3::open3($wtr, $rdr, $err, $cmd) or die "Cannot run $cmd" ; 113 | } 114 | 115 | $self -> out_fh ($wtr) ; 116 | $self -> in_fh ($rdr) ; 117 | 118 | if ( ref($cmd) ) 119 | { 120 | $self -> logger ("@$cmd started\n") ; 121 | } else 122 | { 123 | $self -> logger ("$cmd started\n") ; 124 | } 125 | 126 | async 127 | { 128 | my $data ; 129 | while ($self -> _read (\$data, 8192)) 130 | { 131 | $self -> logger ("stdout ", $data, "\n") ; 132 | $self -> $on_stdout ($data) ; 133 | } 134 | waitpid( $pid, 0 ); 135 | $self -> logger ("@$cmd ended\n") ; 136 | Coro::cede_notself () ; 137 | $self -> $on_exit ($?) ; 138 | } ; 139 | 140 | async 141 | { 142 | my $data ; 143 | while ($self -> _read (\$data, 8192, undef, $err)) 144 | { 145 | $self -> logger ("stderr ", $data, "\n") ; 146 | $self -> $on_stderr ($data) ; 147 | } 148 | } ; 149 | 150 | return $pid ; 151 | } 152 | 153 | 154 | 1 ; 155 | 156 | -------------------------------------------------------------------------------- /lib/Perl/LanguageServer/Methods.pm: -------------------------------------------------------------------------------- 1 | package Perl::LanguageServer::Methods ; 2 | 3 | use Moose::Role ; 4 | use JSON ; 5 | use Data::Dump qw{pp} ; 6 | 7 | no warnings 'uninitialized' ; 8 | 9 | # --------------------------------------------------------------------------- 10 | 11 | sub _rpcreq_initialize 12 | { 13 | my ($self, $workspace, $req) = @_ ; 14 | 15 | #print STDERR "Call initialize\n" ; 16 | $self -> logger ("initialize ", $Perl::LanguageServer::jsonpretty -> encode ($req -> params), "\n") 17 | if ($Perl::LanguageServer::debug1) ; 18 | 19 | $Perl::LanguageServer::workspace = Perl::LanguageServer::Workspace -> new ({ config => $req -> params }) ; 20 | 21 | my $caps = 22 | { 23 | # Defines how text documents are synced. Is either a detailed structure defining each notification or 24 | # for backwards compatibility the TextDocumentSyncKind number. If omitted it defaults to `TextDocumentSyncKind.None`. 25 | textDocumentSync => 1, # full 26 | 27 | # The server provides hover support. 28 | #hoverProvider?: boolean; 29 | 30 | # The server provides completion support. 31 | #completionProvider?: CompletionOptions; 32 | 33 | # The server provides signature help support. 34 | #signatureHelpProvider?: SignatureHelpOptions; 35 | signatureHelpProvider => 36 | { 37 | triggerCharacters => ['('], 38 | }, 39 | 40 | # The server provides goto definition support. 41 | #definitionProvider?: boolean; 42 | definitionProvider => JSON::true, 43 | 44 | # The server provides Goto Type Definition support. 45 | # Since 3.6.0 46 | #typeDefinitionProvider?: boolean | (TextDocumentRegistrationOptions & StaticRegistrationOptions); 47 | 48 | # The server provides Goto Implementation support. 49 | # Since 3.6.0 50 | #implementationProvider?: boolean | (TextDocumentRegistrationOptions & StaticRegistrationOptions); 51 | 52 | # The server provides find references support. 53 | referencesProvider => JSON::true, 54 | 55 | # The server provides document highlight support. 56 | #documentHighlightProvider?: boolean; 57 | 58 | # The server provides document symbol support. 59 | #documentSymbolProvider?: boolean; 60 | documentSymbolProvider => JSON::true, 61 | 62 | # The server provides workspace symbol support. 63 | workspaceSymbolProvider => JSON::true, 64 | 65 | # The server provides code actions. 66 | #codeActionProvider?: boolean; 67 | 68 | # The server provides code lens. 69 | #codeLensProvider?: CodeLensOptions; 70 | 71 | # The server provides document formatting. 72 | #documentFormattingProvider?: boolean; 73 | #documentFormattingProvider => JSON::true, 74 | 75 | # The server provides document range formatting. 76 | #documentRangeFormattingProvider?: boolean; 77 | documentRangeFormattingProvider => JSON::true, 78 | 79 | # The server provides document formatting on typing. 80 | #documentOnTypeFormattingProvider?: DocumentOnTypeFormattingOptions; 81 | 82 | # The server provides rename support. 83 | #renameProvider?: boolean; 84 | 85 | # The server provides document link support. 86 | #documentLinkProvider?: DocumentLinkOptions; 87 | 88 | # The server provides color provider support. 89 | # Since 3.6.0 90 | #colorProvider?: boolean | ColorProviderOptions | (ColorProviderOptions & TextDocumentRegistrationOptions & StaticRegistrationOptions); 91 | 92 | # The server provides execute command support. 93 | #executeCommandProvider?: ExecuteCommandOptions; 94 | 95 | # The server provides selection range support. 96 | # @since 3.15.0 97 | # selectionRangeProvider?: boolean | SelectionRangeOptions | SelectionRangeRegistrationOptions; 98 | 99 | #selectionRangeProvider => JSON::true, 100 | 101 | # Workspace specific server capabilities 102 | workspace => { 103 | 104 | # The server supports workspace folder. 105 | # Since 3.6.0 106 | workspaceFolders => { 107 | 108 | # The server has support for workspace folders 109 | supported => JSON::true, 110 | 111 | # * Whether the server wants to receive workspace folder 112 | # * change notifications. 113 | # * 114 | # * If a strings is provided the string is treated as a ID 115 | # * under which the notification is registered on the client 116 | # * side. The ID can be used to unregister for these events 117 | # * using the `client/unregisterCapability` request. 118 | # */ 119 | changeNotifications => JSON::true, 120 | } 121 | } 122 | 123 | # Experimental server capabilities. 124 | #experimental?: any; 125 | } ; 126 | 127 | return { capabilities => $caps } ; 128 | } 129 | 130 | 131 | # --------------------------------------------------------------------------- 132 | 133 | sub _rpcnot_initialized 134 | { 135 | my ($self, $workspace, $req) = @_ ; 136 | 137 | return if (!$Perl::LanguageServer::client_version) ; 138 | 139 | if ($Perl::LanguageServer::client_version ne $Perl::LanguageServer::VERSION) 140 | { 141 | my $msg = "Version of IDE/Editor plugin is $Perl::LanguageServer::client_version\nVersion of Perl::LanguageServer is $Perl::LanguageServer::VERSION\nPlease make sure you run matching versions of the plugin and the Perl::LanguageServer module\nUse 'cpan Perl::LanguageServer' to install the newest version of the Perl::LanguageServer module\n" ; 142 | $self -> logger ("\n$msg\n") ; 143 | } 144 | return ; 145 | } 146 | 147 | 148 | # --------------------------------------------------------------------------- 149 | 150 | sub _rpcnot_cancelRequest 151 | { 152 | my ($self, $workspace, $req) = @_ ; 153 | 154 | my $cancel_id = $req -> params -> {id} ; 155 | return if (!$cancel_id) ; 156 | return if (!exists $Perl::LanguageServer::running_req{$cancel_id}) ; 157 | $Perl::LanguageServer::running_req{$cancel_id} -> cancel_req ; 158 | 159 | return ; 160 | } 161 | 162 | # --------------------------------------------------------------------------- 163 | 164 | sub _rpcreq_shutdown 165 | { 166 | my ($self, $workspace, $req) = @_ ; 167 | 168 | return if (!$workspace) ; 169 | 170 | $workspace -> shutdown ; 171 | } 172 | 173 | # --------------------------------------------------------------------------- 174 | 175 | sub _rpcnot_exit 176 | { 177 | my ($self, $workspace, $req) = @_ ; 178 | 179 | print STDERR "Exit\n" ; 180 | 181 | exit (1) if (!$workspace) ; 182 | exit (1) if (!$workspace -> is_shutdown) ; 183 | exit (0) ; 184 | return ; 185 | } 186 | 187 | # --------------------------------------------------------------------------- 188 | 189 | 1 ; 190 | -------------------------------------------------------------------------------- /lib/Perl/LanguageServer/Methods/DebugAdapterInterface.pm: -------------------------------------------------------------------------------- 1 | package Perl::LanguageServer::Methods::DebugAdapterInterface ; 2 | 3 | use Moose::Role ; 4 | 5 | use Coro ; 6 | use Coro::AIO ; 7 | use Data::Dump qw{dump} ; 8 | use Perl::LanguageServer::DevTool ; 9 | use Perl::LanguageServer::DebuggerProcess ; 10 | 11 | no warnings 'uninitialized' ; 12 | 13 | our $reqseq = 1_000_000_000 ; 14 | 15 | # --------------------------------------------------------------------------- 16 | 17 | has 'debugger_process' => 18 | ( 19 | isa => 'Perl::LanguageServer::DebuggerProcess', 20 | is => 'rw' 21 | ) ; 22 | 23 | has 'debug_adapter' => 24 | ( 25 | isa => 'Perl::LanguageServer', 26 | is => 'rw', 27 | weak_ref => 1, 28 | predicate => 'has_debug_adapter', 29 | ) ; 30 | 31 | has 'cmd_queue' => 32 | ( 33 | is => 'ro', 34 | isa => 'Coro::Channel', 35 | default => sub { Coro::Channel -> new } 36 | ) ; 37 | 38 | has 'cmd_in_progress' => 39 | ( 40 | is => 'rw', 41 | isa => 'Maybe[HashRef]', 42 | ) ; 43 | 44 | has 'initialized' => 45 | ( 46 | is => 'rw', 47 | isa => 'Bool', 48 | default => 0 49 | ) ; 50 | 51 | has 'responses' => 52 | ( 53 | isa => 'HashRef', 54 | is => 'rw', 55 | default => sub { {} }, 56 | ) ; 57 | 58 | # --------------------------------------------------------------------------- 59 | 60 | sub send_event 61 | { 62 | my ($self, $event, $body) = @_ ; 63 | 64 | $self -> debug_adapter -> send_event ($event, $body) ; 65 | } 66 | 67 | # --------------------------------------------------------------------------- 68 | 69 | sub send_request 70 | { 71 | my ($self) = @_ ; 72 | 73 | return if ($self -> cmd_in_progress) ; 74 | 75 | my $channel = $self -> cmd_queue ; 76 | return if ($channel -> size == 0) ; 77 | my $req = $channel -> get () ; 78 | $self -> cmd_in_progress ($req) ; 79 | $self -> send_notification ($req, $self, "<--- To debuggee: ") ; 80 | 81 | return ; 82 | } 83 | 84 | # --------------------------------------------------------------------------- 85 | 86 | sub request 87 | { 88 | my ($self, $req) = @_ ; 89 | 90 | my $seq = $reqseq++ ; 91 | $req -> {seq} = $seq ; 92 | 93 | my $channels = $self -> responses ; 94 | local $channels -> {$seq} = Coro::Channel -> new ; 95 | 96 | my $channel = $self -> cmd_queue ; 97 | $channel -> put ($req) ; 98 | $self -> send_request () ; 99 | my $ret = $channels -> {$seq} -> get ; 100 | $self -> send_request () ; 101 | return $ret ; 102 | } 103 | 104 | # --------------------------------------------------------------------------- 105 | 106 | sub _dapreq_di_response 107 | { 108 | my ($self, $workspace, $req) = @_ ; 109 | 110 | my $seq = - $req -> id ; 111 | my $cmd = $self -> cmd_in_progress ; 112 | my $cmdseq = $cmd?$cmd -> {seq}:'' ; 113 | my $channels = $self -> responses ; 114 | $self -> logger ("di_response seq = $seq lastcmd seq = $cmdseq channels = ", dump([keys %$channels]), " queue size = ", $self -> cmd_queue -> size, "\n") ; 115 | return if (!exists $channels -> {$seq}) ; 116 | $channels -> {$seq} -> put ($req -> params) ; 117 | $self -> cmd_in_progress (undef) ; 118 | $self -> send_request () ; 119 | return ; 120 | } 121 | 122 | # --------------------------------------------------------------------------- 123 | 124 | sub _dapreq_di_break 125 | { 126 | my ($self, $workspace, $req) = @_ ; 127 | 128 | $self -> log_prefix ('DAI') ; 129 | $self -> log_req_txt ('---> From debuggee: ') ; 130 | 131 | my $debug_adapter = $Perl::LanguageServer::Methods::DebugAdapter::debug_adapters{$req -> params -> {session_id}} ; 132 | die "no debug_adapter for session " . $req -> params -> {session_id} if (!$debug_adapter) ; 133 | $debug_adapter -> running (0) ; 134 | 135 | $self -> logger ("session_id = " . $req -> params -> {session_id} . "\n") ; 136 | #$self -> logger ("debug_adapter = ", dump ($debug_adapter), "\n") ; 137 | 138 | $self -> debug_adapter ($debug_adapter) ; 139 | $self -> debugger_process ($debug_adapter -> debugger_process) ; 140 | $debug_adapter -> debug_adapter_interface ($self) ; 141 | 142 | my $initialized = $self -> initialized ; 143 | my $reason = $req -> params -> {reason} ; 144 | $self -> logger ("_dapreq_di_break reason = $reason initialized = $initialized temp_break = ", $debug_adapter -> in_temp_break, " stop_on_entry = ", $self -> debugger_process -> stop_on_entry,"\n") ; 145 | return if ($reason eq 'pause' && $debug_adapter -> in_temp_break) ; 146 | $debug_adapter -> in_temp_break (0) ; 147 | 148 | $reason ||= $initialized?'breakpoint':'entry' ; 149 | 150 | $debug_adapter -> clear_non_thread_ids ; 151 | 152 | if ($initialized || $self -> debugger_process -> stop_on_entry) 153 | { 154 | $self -> send_event ('stopped', 155 | { 156 | reason => $reason, 157 | threadId => $debug_adapter -> getid (0, $req -> params -> {thread_ref}) || 1, 158 | preserveFocusHint => JSON::false (), 159 | allThreadsStopped => JSON::true (), 160 | }) ; 161 | } 162 | 163 | if (!$initialized) 164 | { 165 | $self -> send_event ('initialized') ; 166 | } 167 | 168 | $self -> initialized (1) ; 169 | 170 | return ; 171 | } 172 | 173 | # --------------------------------------------------------------------------- 174 | 175 | sub _dapreq_di_loadedfile 176 | { 177 | my ($self, $workspace, $req) = @_ ; 178 | 179 | $self -> log_prefix ('DAI') ; 180 | 181 | if (!$self -> has_debug_adapter) 182 | { 183 | my $debug_adapter = $Perl::LanguageServer::Methods::DebugAdapter::debug_adapters{$req -> params -> {session_id}} ; 184 | die "no debug_adapter for session " . $req -> params -> {session_id} if (!$debug_adapter) ; 185 | 186 | $self -> logger ("session_id = " . $req -> params -> {session_id} . "\n") ; 187 | #$self -> logger ("debug_adapter = ", dump ($debug_adapter), "\n") ; 188 | 189 | $self -> debug_adapter ($debug_adapter) ; 190 | $self -> debugger_process ($debug_adapter -> debugger_process) ; 191 | $debug_adapter -> debug_adapter_interface ($self) ; 192 | } 193 | 194 | 195 | $self -> send_event ('loadedSource', 196 | { 197 | reason => $req -> params -> {reason}, 198 | source => $req -> params -> {source}, 199 | }) ; 200 | 201 | return ; 202 | } 203 | 204 | # --------------------------------------------------------------------------- 205 | 206 | sub _dapreq_di_breakpoints 207 | { 208 | my ($self, $workspace, $req) = @_ ; 209 | 210 | $self -> log_prefix ('DAI') ; 211 | 212 | if ($req -> params -> {real_filename}) 213 | { 214 | $workspace -> add_path_mapping ($req -> params -> {real_filename}, $workspace -> file_server2client ($req -> params -> {req_filename})) 215 | } 216 | 217 | foreach my $bp (@{$req -> params -> {breakpoints}}) 218 | { 219 | $self -> send_event ('breakpoint', 220 | { 221 | reason => 'changed', 222 | breakpoint => 223 | { 224 | verified => $bp -> [2]?JSON::true ():JSON::false (), 225 | message => $bp -> [3], 226 | line => $bp -> [4]+0, 227 | id => $bp -> [6]+0, 228 | source => { path => $workspace -> file_server2client ($bp -> [5]) }, 229 | } 230 | }) ; 231 | } 232 | 233 | return ; 234 | } 235 | 236 | # --------------------------------------------------------------------------- 237 | 238 | 1 ; 239 | -------------------------------------------------------------------------------- /lib/Perl/LanguageServer/Methods/textDocument.pm: -------------------------------------------------------------------------------- 1 | package Perl::LanguageServer::Methods::textDocument ; 2 | 3 | use Moose::Role ; 4 | 5 | use Coro ; 6 | use Coro::AIO ; 7 | use Data::Dump qw{pp} ; 8 | use AnyEvent::Util ; 9 | use Encode; 10 | 11 | no warnings 'uninitialized' ; 12 | 13 | 14 | # --------------------------------------------------------------------------- 15 | 16 | sub get_symbol_from_doc 17 | { 18 | my ($self, $workspace, $uri, $pos) = @_ ; 19 | 20 | my $files = $workspace -> files ; 21 | my $text = $files -> {$uri}{text} ; 22 | my $line = $pos -> {line} ; 23 | my $char = $pos -> {character} ; 24 | 25 | $text =~ /(?:.*?\n){$line}(.*?)\n/ ; 26 | my $data = $1 ; 27 | my $datapos = $-[1] ; 28 | $self -> logger ("line $line: <$data>\n") if ($Perl::LanguageServer::debug2) ; 29 | 30 | while ($data =~ /([a-zA-Z0-9_\$\%\@]+)/g) 31 | { 32 | my $pos = pos ($data) ; 33 | my $len = length ($1) ; 34 | $self -> logger ("word: <$1> pos: $pos len: $len\n") if ($Perl::LanguageServer::debug2) ; 35 | if ($char <= $pos && $char >= $pos - $len) 36 | { 37 | $self -> logger ("ok\n") if ($Perl::LanguageServer::debug2) ; 38 | return wantarray?($1, $datapos + $-[1]):$1 ; 39 | } 40 | } 41 | 42 | return ; 43 | } 44 | 45 | # --------------------------------------------------------------------------- 46 | 47 | sub get_symbol_before_left_parenthesis 48 | { 49 | my ($self, $workspace, $uri, $pos) = @_ ; 50 | 51 | my $files = $workspace -> files ; 52 | my $text = $files -> {$uri}{text} ; 53 | my $line = $pos -> {line} ; 54 | my $char = $pos -> {character} - 1 ; 55 | my $cnt = 1 ; 56 | my $i ; 57 | my $endpos ; 58 | my @symbol ; 59 | my $symbolpos ; 60 | 61 | while ($line > 0) 62 | { 63 | $text =~ /(?:.*?\n){$line}(.*?)(?:\n|$)/ ; 64 | my $data = $1 ; 65 | $endpos //= $-[1] + $char ; 66 | my $datapos = $-[1] ; 67 | $self -> logger ("line $line: <$data>\n") if ($Perl::LanguageServer::debug2) ; 68 | $char = length ($data) - 1 if (!defined ($char)) ; 69 | for ($i = $char; $i >= 0; $i--) 70 | { 71 | my $c = substr ($data, $i, 1) ; 72 | if ($cnt == 0) 73 | { 74 | if ($c =~ /\w/) 75 | { 76 | push @symbol, $c ; 77 | $symbolpos = $datapos + $i ; 78 | next ; 79 | } 80 | elsif (@symbol) 81 | { 82 | last ; 83 | } 84 | elsif ($c eq ';') 85 | { 86 | return ; 87 | } 88 | @symbol = () ; 89 | } 90 | if ($c eq '(') 91 | { 92 | $cnt-- 93 | } 94 | elsif ($c eq ')') 95 | { 96 | $cnt++ 97 | } 98 | elsif ($c eq ';') 99 | { 100 | return ; 101 | } 102 | } 103 | last if (@symbol) ; 104 | $line-- ; 105 | $char = undef ; 106 | } 107 | 108 | my $method ; 109 | for ($i = $symbolpos - 1 ; $i > 0; $i--) 110 | { 111 | my $c = substr ($text, $i, 1) ; 112 | if ($c eq '>' && substr ($text, $i - 1, 1) eq '-') 113 | { 114 | $method = 1 ; 115 | last ; 116 | } 117 | last if ($c !~ /\s/) ; 118 | } 119 | 120 | 121 | my $symbol = join ('', reverse @symbol) ; 122 | return ($symbol, substr ($text, $symbolpos, $endpos - $symbolpos + 1), $symbolpos, $endpos, $method) ; 123 | } 124 | 125 | # --------------------------------------------------------------------------- 126 | 127 | sub _rpcnot_didOpen 128 | { 129 | my ($self, $workspace, $req) = @_ ; 130 | 131 | my $files = $workspace -> files ; 132 | my $uri = $req -> params -> {textDocument}{uri} ; 133 | my $text = $req -> params -> {textDocument}{text} ; 134 | my $vers = $req -> params -> {textDocument}{version} ; 135 | $files -> {$uri}{text} = $text ; 136 | $files -> {$uri}{version} = $vers ; 137 | delete $files -> {$uri}{vars} ; 138 | delete $files -> {$uri}{messages} if ($files -> {$uri}{messages_version} < $vers); 139 | 140 | $workspace -> check_perl_syntax ($workspace, $uri, $text) ; 141 | 142 | return ; 143 | } 144 | 145 | # --------------------------------------------------------------------------- 146 | 147 | sub _rpcnot_didChange 148 | { 149 | my ($self, $workspace, $req) = @_ ; 150 | 151 | my $files = $workspace -> files ; 152 | my $uri = $req -> params -> {textDocument}{uri} ; 153 | my $text = $req -> params -> {contentChanges}[0]{text} ; 154 | my $vers = $req -> params -> {textDocument}{version} ; 155 | 156 | $files -> {$uri}{text} = $text ; 157 | $files -> {$uri}{version} = $vers ; 158 | delete $files -> {$uri}{vars} ; 159 | delete $files -> {$uri}{messages} if ($files -> {$uri}{messages_version} < $vers); 160 | 161 | $workspace -> check_perl_syntax ($workspace, $uri, $text) ; 162 | 163 | return ; 164 | } 165 | 166 | # --------------------------------------------------------------------------- 167 | 168 | sub _rpcnot_didClose 169 | { 170 | my ($self, $workspace, $req) = @_ ; 171 | 172 | my $files = $workspace -> files ; 173 | my $uri = $req -> params -> {textDocument}{uri} ; 174 | delete $files -> {$uri}{text} ; 175 | delete $files -> {$uri}{version} ; 176 | delete $files -> {$uri}{vars} ; 177 | delete $files -> {$uri}{messages} ; 178 | 179 | return ; 180 | } 181 | 182 | # --------------------------------------------------------------------------- 183 | 184 | sub _rpcnot_didSave 185 | { 186 | my ($self, $workspace, $req) = @_ ; 187 | 188 | my $uri = $req -> params -> {textDocument}{uri} ; 189 | $workspace -> parser_channel -> put (['save', $uri]) ; 190 | } 191 | 192 | # --------------------------------------------------------------------------- 193 | 194 | sub _filter_children 195 | { 196 | my ($self, $children, $show_local_vars) = @_ ; 197 | 198 | my @vars ; 199 | foreach my $v (@$children) 200 | { 201 | if (exists $v -> {definition} && (!exists $v -> {localvar} || $show_local_vars)) 202 | { 203 | if (exists $v -> {children}) 204 | { 205 | push @vars, { %$v, children => $self -> _filter_children ($v -> {children})} ; 206 | } 207 | else 208 | { 209 | push @vars, $v ; 210 | } 211 | } 212 | } 213 | return \@vars ; 214 | } 215 | 216 | # --------------------------------------------------------------------------- 217 | 218 | sub _rpcreq_documentSymbol 219 | { 220 | my ($self, $workspace, $req) = @_ ; 221 | 222 | my $files = $workspace -> files ; 223 | my $uri = $req -> params -> {textDocument}{uri} ; 224 | my $text = $files -> {$uri}{text} ; 225 | return [] if (!$text) ; 226 | 227 | my $show_local_vars = $workspace -> show_local_vars ; 228 | my $vars = $files -> {$uri}{vars} ; 229 | 230 | if (!$vars) 231 | { 232 | $vars = $workspace -> parse_perl_source ($uri, $text) ; 233 | $files -> {$uri}{vars} = $vars ; 234 | } 235 | my @vars ; 236 | foreach my $v (@$vars) 237 | { 238 | if (exists $v -> {definition} && (!exists $v -> {localvar} || $show_local_vars)) 239 | { 240 | if (exists $v -> {children}) 241 | { 242 | push @vars, { %$v, children => $self -> _filter_children ($v -> {children})} ; 243 | } 244 | else 245 | { 246 | push @vars, $v ; 247 | } 248 | } 249 | } 250 | 251 | return \@vars ; 252 | } 253 | 254 | # --------------------------------------------------------------------------- 255 | 256 | sub _get_symbol 257 | { 258 | my ($self, $workspace, $req, $symbol, $name, $uri, $def_only, $vars) = @_ ; 259 | 260 | if (exists $symbol -> {children}) 261 | { 262 | foreach my $s (@{$symbol -> {children}}) 263 | { 264 | $self -> _get_symbol ($workspace, $req, $s, $name, $uri, $def_only, $vars) ; 265 | last if (@$vars > 500) ; 266 | } 267 | } 268 | 269 | return if ($symbol -> {name} ne $name) ; 270 | #print STDERR "name=$name symbols = ", pp ($symbol), "\n" ; 271 | return if ($def_only && !exists $symbol -> {definition}) ; 272 | my $line = $symbol -> {line} + 0 ; 273 | push @$vars, { uri => $uri, range => { start => { line => $line, character => 0 }, end => { line => $line, character => 0 }}} ; 274 | } 275 | 276 | # --------------------------------------------------------------------------- 277 | 278 | sub _get_symbols 279 | { 280 | my ($self, $workspace, $req, $def_only) = @_ ; 281 | 282 | my $pos = $req -> params -> {position} ; 283 | my $uri = $req -> params -> {textDocument}{uri} ; 284 | 285 | my $name = $self -> get_symbol_from_doc ($workspace, $uri, $pos) ; 286 | 287 | my $symbols = $workspace -> symbols ; 288 | #print STDERR "name=$name symbols = ", pp ($symbols), "\n" ; 289 | my $line ; 290 | my @vars ; 291 | 292 | if ($name) 293 | { 294 | foreach my $uri (keys %$symbols) 295 | { 296 | foreach my $symbol (@{$symbols->{$uri}}) 297 | { 298 | $self -> _get_symbol ($workspace, $req, $symbol, $name, $uri, $def_only, \@vars) ; 299 | last if (@vars > 500) ; 300 | } 301 | } 302 | } 303 | 304 | return \@vars ; 305 | } 306 | 307 | # --------------------------------------------------------------------------- 308 | 309 | sub _rpcreq_definition 310 | { 311 | my ($self, $workspace, $req) = @_ ; 312 | 313 | return $self -> _get_symbols ($workspace, $req, 1) ; 314 | } 315 | 316 | # --------------------------------------------------------------------------- 317 | 318 | sub _rpcreq_references 319 | { 320 | my ($self, $workspace, $req) = @_ ; 321 | 322 | return $self -> _get_symbols ($workspace, $req, 0) ; 323 | } 324 | 325 | # --------------------------------------------------------------------------- 326 | 327 | sub _rpcreq_signatureHelp 328 | { 329 | my ($self, $workspace, $req) = @_ ; 330 | 331 | my $pos = $req -> params -> {position} ; 332 | my $uri = $req -> params -> {textDocument}{uri} ; 333 | $self -> logger (pp($req -> params)) ; 334 | 335 | my ($name, $expr, $symbolpos, $endpos, $method) = $self -> get_symbol_before_left_parenthesis ($workspace, $uri, $pos) ; 336 | 337 | return { signatures => [] } if (!$name) ; 338 | 339 | my $argnum = 0 ; 340 | while ($expr =~ /,/g) 341 | { 342 | $argnum++ ; 343 | } 344 | $argnum += ($method?1:0) ; 345 | 346 | my $symbols = $workspace -> symbols ; 347 | my $line ; 348 | my @vars ; 349 | 350 | foreach my $uri (keys %$symbols) 351 | { 352 | foreach my $symbol (@{$symbols->{$uri}}) 353 | { 354 | next if ($symbol -> {name} ne $name) ; 355 | next if (!exists $symbol -> {definition}) ; 356 | next if (!exists $symbol -> {signature}) ; 357 | 358 | push @vars, $symbol -> {signature} ; 359 | last if (@vars > 200) ; 360 | } 361 | } 362 | 363 | $self -> logger (pp(\@vars)) if ($Perl::LanguageServer::debug2) ; 364 | 365 | my $signum = 0 ; 366 | my $context = $req -> params -> {context} ; 367 | if ($context) 368 | { 369 | $signum = $context -> {activeSignatureHelp}{activeSignature} // 0 ; 370 | } 371 | 372 | return { signatures => \@vars, activeParameter => $argnum + 0, activeSignature => $signum + 0 } ; 373 | } 374 | 375 | # --------------------------------------------------------------------------- 376 | 377 | sub _rpcreq_selectionRange 378 | { 379 | my ($self, $workspace, $req) = @_ ; 380 | 381 | my $pos = $req -> params -> {position} ; 382 | my $uri = $req -> params -> {textDocument}{uri} ; 383 | #$self -> logger (pp($req -> params)) ; 384 | 385 | my ($symbol, $offset) = $self -> get_symbol_from_doc ($workspace, $uri, $pos) ; 386 | 387 | $self -> logger ("sym = $symbol, $offset") ; 388 | 389 | return {} ; 390 | } 391 | 392 | # --------------------------------------------------------------------------- 393 | 394 | sub _rpcreq_rangeFormatting 395 | { 396 | my ($self, $workspace, $req) = @_ ; 397 | 398 | 399 | my $uri = $req -> params -> {textDocument}{uri} ; 400 | my $range = $req -> params -> {range} ; 401 | #$workspace -> parser_channel -> put (['save', $uri]) ; 402 | $self -> logger (pp($req -> params)) ; 403 | my $fn = $uri ; 404 | $fn =~ s/^file:\/\/// ; 405 | $fn = $workspace -> file_client2server ($fn) ; 406 | 407 | #FormattingOptions 408 | # Size of a tab in spaces. 409 | #tabSize: uinteger; 410 | # Prefer spaces over tabs. 411 | #insertSpaces: boolean; 412 | # Trim trailing whitespace on a line. 413 | #trimTrailingWhitespace?: boolean; 414 | # Insert a newline character at the end of the file if one does not exist. 415 | # insertFinalNewline?: boolean; 416 | #trimFinalNewlines?: boolean; 417 | 418 | my $ret ; 419 | my $out ; 420 | my $errout ; 421 | 422 | my $files = $workspace -> files ; 423 | my $text = $files -> {$uri}{text} ; 424 | 425 | my $start = $range -> {start}{line} ; 426 | my $end = $range -> {end}{line} ; 427 | my $char = $range -> {end}{character} ; 428 | $end-- if ($end > 0 && $char == 0) ; 429 | my $lines = $end - $start + 1 ; 430 | 431 | $text =~ /(?:.*?\n){$start}((?:.*?\n){$lines})/ ; 432 | my $range_text = $1 ; 433 | $range_text =~ s/\n$// ; 434 | if ($range_text eq '') 435 | { 436 | $text =~ /(?:.*?\n){$start}(.+)/s ; 437 | $range_text = $1 ; 438 | $range_text =~ s/\n$// ; 439 | } 440 | $self -> logger ('perltidy text: <' . $range_text . ">\n") if ($Perl::LanguageServer::debug2) ; 441 | 442 | return [] if ($range_text eq '') ; 443 | 444 | my $lang = $ENV{LANG} ; 445 | my $encoding = 'UTF-8' ; 446 | $encoding = $1 if ($lang =~ /\.(.+)/) ; 447 | $range_text = Encode::encode($encoding, $range_text) ; 448 | 449 | $self -> logger ("start perltidy $uri from line $start to $end\n") if ($Perl::LanguageServer::debug1) ; 450 | if ($^O =~ /Win/) 451 | { 452 | ($ret, $out, $errout) = $workspace -> run_open3 ($range_text, []) ; 453 | } 454 | else 455 | { 456 | $ret = run_cmd (['perltidy', '-st', '-se'], 457 | "<", \$range_text, 458 | ">", \$out, 459 | "2>", \$errout) 460 | -> recv ; 461 | } 462 | 463 | my $rc = $ret >> 8 ; 464 | $self -> logger ("perltidy rc=$rc errout=$errout\n") if ($Perl::LanguageServer::debug1) ; 465 | 466 | my @messages ; 467 | if ($rc != 0) 468 | { 469 | my $line ; 470 | my @lines = split /\n/, $errout ; 471 | my $lineno = 0 ; 472 | my $filename ; 473 | my $msg ; 474 | my $severity = 2 ; 475 | foreach $line (@lines) 476 | { 477 | next if ($line !~ /^(.+?):(\d+):(.+)/) ; 478 | 479 | $filename = $1 eq ''?$fn:$1 ; 480 | $lineno = $2 ; 481 | $msg = $3 ; 482 | push @messages, [$filename, $lineno, $severity, $msg] if ($lineno && $msg) ; 483 | } 484 | } 485 | $workspace -> add_diagnostic_messages ($self, $uri, 'perltidy', \@messages, $files -> {$uri}{version} + 1) ; 486 | 487 | die "perltidy failed with exit code $rc" if ($rc != 0 && $out eq '') ; 488 | 489 | # make sure range is numeric 490 | $range -> {start}{line} += 0 ; 491 | $range -> {start}{character} = 0 ; 492 | $range -> {end}{line} += $range -> {end}{character} > 0?1:0 ; 493 | $range -> {end}{character} = 0 ; 494 | 495 | return [ { newText => Encode::decode($encoding, $out), range => $range } ] ; 496 | } 497 | 498 | # --------------------------------------------------------------------------- 499 | 500 | 1 ; 501 | -------------------------------------------------------------------------------- /lib/Perl/LanguageServer/Methods/workspace.pm: -------------------------------------------------------------------------------- 1 | 2 | 3 | package Perl::LanguageServer::Methods::workspace ; 4 | 5 | use strict ; 6 | use Moose::Role ; 7 | 8 | use Coro ; 9 | 10 | use Data::Dump qw{dump} ; 11 | 12 | # --------------------------------------------------------------------------- 13 | 14 | sub _rpcnot_didChangeConfiguration 15 | { 16 | my ($self, $workspace, $req) = @_ ; 17 | 18 | my $log_file = $req -> params -> {settings}{perl}{logFile} ; 19 | if ($log_file) 20 | { 21 | $Perl::LanguageServer::log_file = $log_file; 22 | $self -> logger ("log_file = $log_file\n") ; 23 | } 24 | 25 | $self -> logger ("perl = ", dump ($req -> params -> {settings}{perl}), "\n") ; 26 | 27 | my $log_level = $req -> params -> {settings}{perl}{logLevel} ; 28 | if (defined $log_level && length $log_level) 29 | { 30 | my $int_log_level = 0+$log_level; 31 | if ($int_log_level >= 0 && $int_log_level <= 2) 32 | { 33 | $Perl::LanguageServer::debug1 = $int_log_level; 34 | $Perl::LanguageServer::debug2 = $int_log_level > 1?1:0; 35 | $self -> logger ("log_level = $int_log_level\n") ; 36 | } 37 | else 38 | { 39 | $self -> logger ("log_level: unexpected value ($log_level)\n") ; 40 | } 41 | } 42 | 43 | my $uri = $req -> params -> {settings}{perl}{sshWorkspaceRoot} ; 44 | if ($uri) 45 | { 46 | $uri =~ s/\\/\//g ; 47 | $uri = 'file://' . $uri if ($uri !~ /^file:/) ; 48 | $workspace -> path_map ([[$uri, $workspace -> config -> {rootUri}]]) ; 49 | } 50 | my $map = $req -> params -> {settings}{perl}{pathMap} ; 51 | if ($map) 52 | { 53 | my $fn ; 54 | foreach (@$map) 55 | { 56 | $fn = $_ -> [0] ; 57 | $fn =~ s/^file:// ; 58 | $fn =~ s/^\/\/\//\// ; 59 | $_ -> [2] ||= $fn ; 60 | $fn = $_ -> [1] ; 61 | $fn =~ s/^file:// ; 62 | $fn =~ s/^\/\/\//\// ; 63 | $_ -> [3] ||= $fn ; 64 | } 65 | $workspace -> path_map ($map) ; 66 | } 67 | 68 | $self -> logger ("path_map = ", dump ( $workspace -> path_map), "\n") ; 69 | 70 | my $inc = $req -> params -> {settings}{perl}{perlInc} ; 71 | if ($inc) 72 | { 73 | $inc = [$inc] if (!ref $inc) ; 74 | $workspace -> perlinc ($inc) ; 75 | } 76 | 77 | $self -> logger ("perlinc = ", dump ( $workspace -> perlinc), "\n") ; 78 | 79 | $workspace -> use_taint_for_syntax_check ($req -> params -> {settings}{perl}{useTaintForSyntaxCheck}) ; 80 | $self -> logger ("use_taint_for_syntax_check = ", dump ( $workspace -> use_taint_for_syntax_check), "\n") ; 81 | 82 | my $filter = $req -> params -> {settings}{perl}{fileFilter} ; 83 | if ($filter) 84 | { 85 | $filter = [$filter] if (!ref $filter) ; 86 | $workspace -> file_filter_regex ('(?:' . join ('|', map { quotemeta($_) } @$filter ) . ')$') ; 87 | } 88 | 89 | $self -> logger ("file_filter_regex = ", dump ( $workspace -> file_filter_regex), "\n") ; 90 | 91 | my $dirs = $req -> params -> {settings}{perl}{ignoreDirs} ; 92 | if ($dirs) 93 | { 94 | $dirs = [$dirs] if (!ref $dirs) ; 95 | $workspace -> ignore_dir ({ map { ( $_ => 1 ) } @$dirs }) ; 96 | } 97 | 98 | $self -> logger ("ignore_dir = ", dump ( $workspace -> ignore_dir), "\n") ; 99 | 100 | if (!exists ($workspace -> config -> {workspaceFolders}) || @{$workspace -> config -> {workspaceFolders} // []} == 0) 101 | { 102 | $workspace -> config -> {workspaceFolders} = [{ uri => $workspace -> config -> {rootUri} }] ; 103 | } 104 | 105 | $workspace -> set_workspace_folders ($workspace -> config -> {workspaceFolders} ) ; 106 | 107 | $workspace -> show_local_vars ($workspace -> config -> {showLocalVars}) ; 108 | $workspace -> disable_cache ($workspace -> config -> {disableCache}) ; 109 | 110 | if ($req -> params -> {settings}{perl}{cacheDir}) 111 | { 112 | $workspace -> state_dir ($req -> params -> {settings}{perl}{cacheDir}) ; 113 | } 114 | else 115 | { 116 | $workspace -> clear_state_dir 117 | } 118 | 119 | $workspace -> mkpath ($workspace -> state_dir) ; # force build state dir 120 | 121 | async 122 | { 123 | $workspace -> background_parser ($self) ; 124 | } ; 125 | 126 | async 127 | { 128 | $workspace -> background_checker ($self) ; 129 | } ; 130 | 131 | 132 | return ; 133 | } 134 | 135 | # --------------------------------------------------------------------------- 136 | 137 | 138 | sub _rpcnot_didChangeWorkspaceFolders 139 | { 140 | my ($self, $workspace, $req) = @_ ; 141 | 142 | my $added = $req -> params -> {event}{added} ; 143 | if ($added) 144 | { 145 | $workspace -> set_workspace_folders ($added) ; 146 | } 147 | 148 | my $removed = $req -> params -> {event}{removed} ; 149 | if ($removed) 150 | { 151 | foreach my $folder (@$removed) 152 | { 153 | my $uri = $folder -> {uri} ; 154 | #TODO 155 | } 156 | } 157 | 158 | async 159 | { 160 | $workspace -> background_parser ($self) ; 161 | } ; 162 | 163 | } 164 | 165 | # --------------------------------------------------------------------------- 166 | 167 | sub _rpcreq_symbol 168 | { 169 | my ($self, $workspace, $req) = @_ ; 170 | 171 | my $query = $req -> params -> {query} || '.' ; 172 | my $symbols = $workspace -> symbols ; 173 | #$self -> logger ("symbols = ", dump ($symbols), "\n") ; 174 | my $line ; 175 | my @vars ; 176 | 177 | foreach my $uri (keys %$symbols) 178 | { 179 | foreach my $symbol (@{$symbols->{$uri}}) 180 | { 181 | next if ($symbol -> {name} !~ /$query/) ; 182 | next if (!exists $symbol -> {definition}) ; 183 | $line = $symbol -> {line} ; 184 | push @vars, { %$symbol, location => { uri => $uri, range => { start => { line => $line, character => 0 }, end => { line => $line, character => 0 }}} } ; 185 | last if (@vars > 200) ; 186 | } 187 | } 188 | 189 | return \@vars ; 190 | } 191 | 192 | # --------------------------------------------------------------------------- 193 | 194 | 1 ; 195 | -------------------------------------------------------------------------------- /lib/Perl/LanguageServer/Parser.pm: -------------------------------------------------------------------------------- 1 | package Perl::LanguageServer::Parser ; 2 | 3 | use Moose::Role ; 4 | 5 | use Coro ; 6 | use Coro::AIO ; 7 | use JSON ; 8 | use File::Basename ; 9 | 10 | use v5.16; 11 | 12 | no warnings 'uninitialized' ; 13 | 14 | use Compiler::Lexer; 15 | use Data::Dump qw{dump} ; 16 | 17 | use constant SymbolKindFile => 1; 18 | use constant SymbolKindModule => 2; 19 | use constant SymbolKindNamespace => 3; 20 | use constant SymbolKindPackage => 4; 21 | use constant SymbolKindClass => 5; 22 | use constant SymbolKindMethod => 6; 23 | use constant SymbolKindProperty => 7; 24 | use constant SymbolKindField => 8; 25 | use constant SymbolKindConstructor => 9; 26 | use constant SymbolKindEnum => 10; 27 | use constant SymbolKindInterface => 11; 28 | use constant SymbolKindFunction => 12; 29 | use constant SymbolKindVariable => 13; 30 | use constant SymbolKindConstant => 14; 31 | use constant SymbolKindString => 15; 32 | use constant SymbolKindNumber => 16; 33 | use constant SymbolKindBoolean => 17; 34 | use constant SymbolKindArray => 18; 35 | use constant SymbolKindObject => 19; 36 | use constant SymbolKindKey => 20; 37 | use constant SymbolKindNull => 21; 38 | use constant SymbolKindEnumMember => 22; 39 | use constant SymbolKindStruct => 23; 40 | use constant SymbolKindEvent => 24; 41 | use constant SymbolKindOperator => 25; 42 | use constant SymbolKindTypeParameter => 26; 43 | 44 | use constant CacheVersion => 5 ; 45 | 46 | 47 | # --------------------------------------------------------------------------- 48 | 49 | sub _get_docu 50 | { 51 | my ($self, $source, $line) = @_ ; 52 | 53 | my @docu ; 54 | my $in_pod ; 55 | while ($line-- >= 0) 56 | { 57 | my $src = $source -> [$line] ; 58 | if ($src =~ /^=cut/) 59 | { 60 | $in_pod = 1 ; 61 | next ; 62 | } 63 | 64 | if ($in_pod) 65 | { 66 | last if ($src =~ /^=pod/) ; 67 | next if ($src =~ /^=\w+\s*$/) ; 68 | $src =~ s/^=item /* / ; 69 | unshift @docu, $src ; 70 | } 71 | else 72 | { 73 | next if ($src =~ /^\s*$/) ; 74 | next if ($src =~ /^\s*#[-#+~= \t]+$/) ; 75 | last if ($src !~ /^\s*#(.*?)\s*$/) ; 76 | unshift @docu, $1 ; 77 | } 78 | } 79 | 80 | shift @docu while (@docu && ($docu[0] =~ /^\s*$/)) ; 81 | pop @docu while (@docu && ($docu[-1] =~ /^\s*$/)) ; 82 | 83 | return join ("\n", @docu) ; 84 | } 85 | 86 | 87 | # --------------------------------------------------------------------------- 88 | 89 | 90 | sub parse_perl_source 91 | { 92 | my ($self, $uri, $source, $server) = @_ ; 93 | 94 | $source =~ s/\r//g ; # Compiler::Lexer computes wrong line numbers with \r 95 | my @source = split /\n/, $source ; 96 | 97 | my $lexer = Compiler::Lexer->new(); 98 | my $tokens = $lexer->tokenize($source); 99 | 100 | cede () ; 101 | 102 | #$server -> logger (dump ($tokens) . "\n") ; 103 | 104 | #my $modules = $lexer->get_used_modules($script); 105 | 106 | my @vars ; 107 | my $package = 'main::' ; 108 | my %state ; 109 | my $decl ; 110 | my $declline ; 111 | my $func ; 112 | my $parent ; 113 | my $top ; 114 | my $add ; 115 | my $func_param ; 116 | my $token_ndx = -1 ; 117 | my $brace_level = 0 ; 118 | my @stack ; 119 | my $beginchar = 0 ; 120 | my $endchar = 0 ; 121 | 122 | foreach my $token (@$tokens) 123 | { 124 | $token_ndx++ ; 125 | $token -> {data} =~ s/\r$// ; 126 | $server -> logger ("token=", dump ($token), "\n") if ($Perl::LanguageServer::debug3) ; 127 | 128 | if (exists $state{method_mod} && $token -> {name} eq 'RawString') 129 | { 130 | $token -> {name} = 'Function' ; 131 | delete $state{method_mod} ; 132 | } 133 | 134 | my $name = $token -> {name} ; 135 | if ($name =~ /^(?:VarDecl|OurDecl|FunctionDecl)$/) 136 | { 137 | $decl = $token -> {data}, 138 | $declline = $token -> {line} ; 139 | } 140 | elsif ($name =~ /Var$/) 141 | { 142 | $top = $decl eq 'our' || !$parent?\@vars:$parent ; 143 | push @$top, 144 | { 145 | name => $token -> {data}, 146 | kind => SymbolKindVariable, 147 | containerName => $decl eq 'our'?$package:$func, 148 | ($decl?(definition => $decl):()), 149 | ($decl eq 'my'?(localvar => $decl):()), 150 | } ; 151 | $add = $top -> [-1] ; 152 | $token -> {line} = $declline if ($decl) ; 153 | $decl = undef ; 154 | } 155 | elsif ($name eq 'LeftBrace') 156 | { 157 | $brace_level++ ; 158 | $decl = undef ; 159 | if (@vars && $vars[-1]{kind} == SymbolKindVariable) 160 | { 161 | $vars[-1]{name} =~ s/^\$/%/ ; 162 | } 163 | } 164 | elsif ($name =~ /^(?:RightBrace|SemiColon)$/) 165 | { 166 | $brace_level-- if ($name eq 'RightBrace') ; 167 | if (@stack > 0 && $brace_level == $stack[-1]{brace_level}) 168 | { 169 | my $stacktop = pop @stack ; 170 | $parent = $stacktop -> {parent} ; 171 | $func = $stacktop -> {func} ; 172 | my $symbol = $stacktop -> {symbol} ; 173 | my $start_line = $symbol -> {range}{start}{line} // $symbol -> {line} ; 174 | $symbol -> {range} = { start => { line => $start_line, character => 0 }, end => { line => $token -> {line}-1, character => 9999 }} 175 | if (defined ($start_line)) ; 176 | } 177 | if ($name eq 'SemiColon') 178 | { 179 | $decl = undef ; 180 | # continue does only work in switch statement, which is deprecated and was removed 181 | # unclear, if this is still necessray? 182 | #continue ; 183 | } 184 | } 185 | elsif ($name eq 'LeftBracket') 186 | { 187 | if (@vars && $vars[-1]{kind} == SymbolKindVariable) 188 | { 189 | $vars[-1]{name} =~ s/^\$/@/ ; 190 | } 191 | } 192 | elsif ($name =~ /^(?:Function|Method)$/) 193 | { 194 | if ($token -> {data} =~ /^\w/) 195 | { 196 | $top = !$parent?\@vars:$parent ; 197 | push @$top, 198 | { 199 | name => $token -> {data}, 200 | kind => SymbolKindFunction, 201 | containerName => @stack?$func:$package, 202 | ($decl?(definition => $decl):()), 203 | } ; 204 | $func_param = $add = $top -> [-1] ; 205 | if ($decl) 206 | { 207 | push @stack, 208 | { 209 | brace_level => $brace_level, 210 | parent => $parent, 211 | func => $func, 212 | 'package' => $package, 213 | symbol => $add, 214 | } ; 215 | $token -> {line} = $declline ; 216 | $func = $token -> {data} ; 217 | $parent = $top -> [-1]{children} ||= [] ; 218 | } 219 | my $src = $source[$token -> {line}-1] ; 220 | my $i ; 221 | if ($src && ($i = index($src, $func) >= 0)) 222 | { 223 | $beginchar = $i + 1 ; 224 | $endchar = $i + 1 + length ($func) ; 225 | } 226 | } 227 | $decl = undef ; 228 | } 229 | elsif ($name eq 'ArgumentArray') 230 | { 231 | if ($func_param) 232 | { 233 | my @params ; 234 | if ($tokens -> [$token_ndx - 1]{name} eq 'Assign' && 235 | $tokens -> [$token_ndx - 2]{name} eq 'RightParenthesis') 236 | { 237 | for (my $i = $token_ndx - 3; $i >= 0; $i--) 238 | { 239 | next if ($tokens -> [$i]{name} eq 'Comma') ; 240 | last if ($tokens -> [$i]{name} !~ /Var$/) ; 241 | push @params, $tokens -> [$i]{data} ; 242 | } 243 | my $func_doc = $self -> _get_docu (\@source, $func_param -> {range}{start}{line} // $func_param -> {line}) ; 244 | my @parameters ; 245 | foreach my $p (reverse @params) 246 | { 247 | push @parameters, 248 | { 249 | label => $p, 250 | } ; 251 | } 252 | $func_param -> {detail} = '(' . join (',', reverse @params) . ')' ; 253 | $func_param -> {signature} = 254 | { 255 | label => $func_param -> {name} . $func_param -> {detail}, 256 | documentation => $func_doc, 257 | parameters => \@parameters 258 | } ; 259 | } 260 | $func_param = undef ; 261 | } 262 | } 263 | elsif ($name eq 'Prototype') 264 | { 265 | if ($func_param) 266 | { 267 | my @params = split /\s*,\s*/, $token -> {data} ; 268 | my $func_doc = $self -> _get_docu (\@source, $func_param -> {range}{start}{line} // $func_param -> {line}) ; 269 | my @parameters ; 270 | foreach my $p (@params) 271 | { 272 | push @parameters, 273 | { 274 | label => $p, 275 | } ; 276 | } 277 | $func_param -> {detail} = '(' . join (',', @params) . ')' ; 278 | $func_param -> {signature} = 279 | { 280 | label => $func_param -> {name} . $func_param -> {detail}, 281 | documentation => $func_doc, 282 | parameters => \@parameters 283 | } ; 284 | $func_param = undef ; 285 | } 286 | } 287 | elsif ($name =~ /^(?:Package|UseDecl)$/) 288 | { 289 | $state{is} = $token -> {data} ; 290 | $state{module} = 1 ; 291 | } 292 | elsif ($name =~ /^(?:ShortHashDereference|ShortArrayDereference)$/) 293 | { 294 | $state{scalar} = '$' ; 295 | } 296 | elsif ($name eq 'Key') 297 | { 298 | if (exists ($state{constant})) 299 | { 300 | $top = \@vars ; 301 | push @$top, 302 | { 303 | name => $token -> {data}, 304 | kind => SymbolKindConstant, 305 | containerName => $package, 306 | definition => 1, 307 | } ; 308 | $add = $top -> [-1] ; 309 | } 310 | elsif (exists ($state{scalar})) 311 | { 312 | $top = $decl eq 'our' || !$parent?\@vars:$parent ; 313 | push @$top, 314 | { 315 | name => $state{scalar} . $token -> {data}, 316 | kind => SymbolKindVariable, 317 | containerName => $decl eq 'our'?$package:$func, 318 | } ; 319 | $add = $top -> [-1] ; 320 | } 321 | elsif ($token -> {data} =~ /^(?:has|class_has)$/) 322 | { 323 | $state{has} = 1 ; 324 | } 325 | elsif ($token -> {data} =~ /^(?:around|before|after)$/) 326 | { 327 | $state{method_mod} = 1 ; 328 | $decl = $token -> {data}, 329 | $declline = $token -> {line} ; 330 | } 331 | elsif ($token -> {data} =~ /^[a-z_][a-z0-9_]+$/i) 332 | { 333 | $top = \@vars ; 334 | push @$top, 335 | { 336 | name => $token -> {data}, 337 | kind => SymbolKindFunction, 338 | } ; 339 | $add = $top -> [-1] ; 340 | } 341 | } 342 | elsif ($name eq 'RawString') 343 | { 344 | if (exists ($state{has})) 345 | { 346 | $top = \@vars ; 347 | push @$top, 348 | { 349 | name => $token -> {data}, 350 | kind => SymbolKindProperty, 351 | containerName => $package, 352 | definition => 1, 353 | } ; 354 | $add = $top -> [-1] ; 355 | } 356 | } 357 | elsif ($name eq 'UsedName') 358 | { 359 | if ($token -> {data} eq 'constant') 360 | { 361 | delete $state{module} ; 362 | $state{constant} = 1 ; 363 | } 364 | else 365 | { 366 | $state{ns} = [$token->{data}] ; 367 | } 368 | } 369 | elsif($name eq 'Namespace') 370 | { 371 | $state{ns} ||= [] ; 372 | push @{$state{ns}}, $token -> {data} ; 373 | } 374 | elsif ($name eq 'NamespaceResolver') 375 | { 376 | # make sure it is not matched below 377 | } 378 | elsif ($name eq 'Assign' or $token -> {data} =~ /^\W/) 379 | { 380 | if ($name eq 'Assign') 381 | { 382 | $decl = undef ; 383 | } 384 | 385 | if (exists ($state{ns})) 386 | { 387 | if ($state{module}) 388 | { 389 | my $def ; 390 | if ($state{is} eq 'package') 391 | { 392 | $def = 1 ; 393 | $package = join ('::', @{$state{ns}}) ; 394 | $top = \@vars ; 395 | push @$top, 396 | { 397 | name => $package, 398 | kind => SymbolKindModule, 399 | #containerName => join ('::', @{$state{ns}}), 400 | #($def?(definition => $def):()), 401 | definition => 1, 402 | } ; 403 | $add = $top -> [-1] ; 404 | } 405 | else 406 | { 407 | my $name = pop @{$state{ns}} ; 408 | $top = \@vars ; 409 | push @$top, 410 | { 411 | name => $name, 412 | kind => SymbolKindModule, 413 | containerName => join ('::', @{$state{ns}}), 414 | ($def?(definition => $def):()), 415 | } ; 416 | $add = $top -> [-1] ; 417 | } 418 | } 419 | else 420 | { 421 | my $name = shift @{$state{ns}} ; 422 | $top = \@vars ; 423 | push @$top, 424 | { 425 | name => $name, 426 | kind => SymbolKindFunction, 427 | containerName => join ('::', @{$state{ns}}), 428 | } ; 429 | $add = $top -> [-1] ; 430 | } 431 | } 432 | 433 | %state = () ; 434 | } 435 | if ($add) 436 | { 437 | if (!$uri) 438 | { 439 | $add -> {line} = $token -> {line}-1 ; 440 | } 441 | else 442 | { 443 | #$add -> {location} = { uri => $uri, range => { start => { line => $token -> {line}-1, character => 0 }, end => { line => $token -> {line}-1, character => 0 }}} ; 444 | $add -> {range} = { start => { line => $token -> {line}-1, character => 0 }, 445 | end => { line => $token -> {line}-1, character => ($endchar?9999:0) }} ; 446 | $add -> {selectionRange} = { start => { line => $token -> {line}-1, character => $beginchar }, 447 | end => { line => $token -> {line}-1, character => $endchar }} ; 448 | $beginchar = $endchar = 0 ; 449 | } 450 | $server -> logger ("var=", dump ($add), "\n") if ($Perl::LanguageServer::debug3) ; 451 | $add = undef ; 452 | } 453 | } 454 | 455 | $server -> logger (dump (\@vars), "\n") if ($Perl::LanguageServer::debug3) ; 456 | 457 | return wantarray?(\@vars, $tokens):\@vars ; 458 | } 459 | 460 | 461 | # ---------------------------------------------------------------------------- 462 | 463 | sub _parse_perl_source_cached 464 | { 465 | my ($self, $uri, $source, $path, $stats, $server) = @_ ; 466 | 467 | my $cachepath ; 468 | if (!$self -> disable_cache) 469 | { 470 | my $escpath = $path ; 471 | $escpath =~ s/:/%3A/ ; 472 | $cachepath = $self -> state_dir .'/' . $escpath ; 473 | $self -> mkpath (dirname ($cachepath)) ; 474 | 475 | #$server -> logger ("$path -> cachepath=$cachepath\n") ; 476 | aio_stat ($cachepath) ; 477 | if (-e _) 478 | { 479 | my $mtime_cache = -M _ ; 480 | aio_stat ($path) ; 481 | my $mtime_src = -M _ ; 482 | #$server -> logger ("cache = $mtime_cache src = $mtime_src\n") ; 483 | if ($mtime_src > $mtime_cache) 484 | { 485 | #$server -> logger ("load from cache\n") ; 486 | my $cache ; 487 | aio_load ($cachepath, $cache) ; 488 | my $cache_data = eval { $Perl::LanguageServer::json -> decode ($cache) ; } ; 489 | if ($@) 490 | { 491 | $self -> logger ("Loading of $cachepath failed, reparse file ($@)\n") ; 492 | } 493 | elsif (ref ($cache_data) eq 'HASH') 494 | { 495 | if ($cache_data -> {version} == CacheVersion) 496 | { 497 | $stats -> {loaded}++ ; 498 | return $cache_data -> {vars} ; 499 | } 500 | } 501 | } 502 | } 503 | } 504 | 505 | my $vars = $self -> parse_perl_source ($uri, $source, $server) ; 506 | 507 | if ($cachepath) 508 | { 509 | my $ifh = aio_open ($cachepath, IO::AIO::O_WRONLY | IO::AIO::O_TRUNC | IO::AIO::O_CREAT, 0664) or die "open $cachepath failed ($!)" ; 510 | aio_write ($ifh, undef, undef, $Perl::LanguageServer::json -> encode ({ version => CacheVersion, vars => $vars}), 0) ; 511 | aio_close ($ifh) ; 512 | } 513 | 514 | $stats -> {parsed}++ ; 515 | 516 | return $vars ; 517 | } 518 | 519 | 520 | 521 | # ---------------------------------------------------------------------------- 522 | 523 | sub _parse_dir 524 | { 525 | my ($self, $server, $dir, $vars, $stats) = @_ ; 526 | 527 | my $text ; 528 | my $fn ; 529 | my $uri ; 530 | my $file_vars ; 531 | 532 | my $filefilter = $self -> file_filter_regex ; 533 | my $ignore_dir = $self -> ignore_dir ; 534 | 535 | my ($dirs, $files) = aio_scandir ($dir, 4) ; 536 | 537 | if ($dirs) 538 | { 539 | foreach my $d (sort @$dirs) 540 | { 541 | next if (exists $ignore_dir -> {$d}) ; 542 | $self -> _parse_dir ($server, $dir . '/' . $d, $vars, $stats) ; 543 | } 544 | } 545 | 546 | if ($files) 547 | { 548 | foreach my $f (sort @$files) 549 | { 550 | next if ($f !~ /$filefilter/) ; 551 | 552 | $fn = $dir . '/' . $f ; 553 | aio_load ($fn, $text) ; 554 | 555 | $uri = $self -> uri_server2client ('file://' . $fn) ; 556 | #$server -> logger ("parse $fn -> $uri\n") ; 557 | $file_vars = $self -> _parse_perl_source_cached (undef, $text, $fn, $stats, $server) ; 558 | $vars -> {$uri} = $file_vars ; 559 | #$server -> logger ("done $fn\n") ; 560 | my $cnt = keys %$vars ; 561 | $server -> logger ("loaded $stats->{loaded} files, parsed $stats->{parsed} files, $cnt files\n") if ($cnt % 100 == 0) ; 562 | } 563 | } 564 | 565 | 566 | } 567 | 568 | # ---------------------------------------------------------------------------- 569 | 570 | sub background_parser 571 | { 572 | my ($self, $server) = @_ ; 573 | 574 | my $channel = $self -> parser_channel ; 575 | $channel -> shutdown ; # end other parser 576 | cede ; 577 | 578 | $channel = $self -> parser_channel (Coro::Channel -> new) ; 579 | my $folders = $self -> folders ; 580 | $server -> logger ("background_parser folders = ", dump ($folders), "\n") ; 581 | %{$self -> symbols} = () ; 582 | 583 | my $stats = {} ; 584 | foreach my $dir (values %$folders) 585 | { 586 | $self -> _parse_dir ($server, $dir, $self -> symbols, $stats) ; 587 | cede ; 588 | } 589 | 590 | my $cnt = keys %{$self -> symbols} ; 591 | $server -> logger ("initial parsing done, loaded $stats->{loaded} files, parsed $stats->{parsed} files, $cnt files\n") ; 592 | 593 | my $filefilter = $self -> file_filter_regex ; 594 | 595 | while (my $item = $channel -> get) 596 | { 597 | my ($cmd, $uri) = @$item ; 598 | 599 | my $fn = substr ($self -> uri_client2server ($uri), 7) ; 600 | next if (basename ($fn) !~ /$filefilter/) ; 601 | 602 | my $text ; 603 | aio_load ($fn, $text) ; 604 | 605 | $server -> logger ("parse $fn -> $uri\n") ; 606 | my $file_vars = $self -> _parse_perl_source_cached (undef, $text, $fn, {}, $server) ; 607 | $self -> symbols -> {$uri} = $file_vars ; 608 | } 609 | 610 | $server -> logger ("background_parser quit\n") ; 611 | } 612 | 613 | 614 | 615 | 1 ; 616 | 617 | 618 | 619 | -------------------------------------------------------------------------------- /lib/Perl/LanguageServer/Req.pm: -------------------------------------------------------------------------------- 1 | package Perl::LanguageServer::Req ; 2 | 3 | use strict; 4 | use Moose ; 5 | 6 | no warnings 'uninitialized' ; 7 | 8 | # --------------------------------------------------------------------------- 9 | 10 | has 'id' => 11 | ( 12 | isa => 'Maybe[Str]', 13 | is => 'ro' 14 | ) ; 15 | 16 | has 'params' => 17 | ( 18 | isa => 'HashRef', 19 | is => 'ro' 20 | ) ; 21 | 22 | has 'cancel' => 23 | ( 24 | isa => 'Bool', 25 | is => 'rw', 26 | default => 0, 27 | ) ; 28 | 29 | has 'is_dap' => 30 | ( 31 | isa => 'Bool', 32 | is => 'rw', 33 | default => 0, 34 | ) ; 35 | 36 | has 'type' => 37 | ( 38 | isa => 'Str', 39 | is => 'rw', 40 | ) ; 41 | 42 | # --------------------------------------------------------------------------- 43 | 44 | sub cancel_req 45 | { 46 | my ($self) = @_ ; 47 | 48 | $self -> cancel (1) ; 49 | 50 | } 51 | 52 | 53 | # --------------------------------------------------------------------------- 54 | 55 | 1 ; 56 | 57 | -------------------------------------------------------------------------------- /lib/Perl/LanguageServer/SyntaxChecker.pm: -------------------------------------------------------------------------------- 1 | package Perl::LanguageServer::SyntaxChecker ; 2 | 3 | use Moose::Role ; 4 | use strict ; 5 | 6 | use Coro ; 7 | use Coro::AIO ; 8 | use Coro::Channel ; 9 | use AnyEvent::Util ; 10 | use File::Temp ; 11 | use Encode ; 12 | 13 | #use Proc::FastSpawn; 14 | 15 | no warnings 'uninitialized' ; 16 | 17 | # --------------------------------------------------------------------------- 18 | 19 | 20 | has 'infile' => 21 | ( 22 | is => 'rw', 23 | isa => 'Str', 24 | lazy_build => 1, 25 | ) ; 26 | 27 | has 'outfile' => 28 | ( 29 | is => 'rw', 30 | isa => 'Str', 31 | lazy_build => 1, 32 | ) ; 33 | 34 | has 'checker_channel' => 35 | ( 36 | is => 'ro', 37 | isa => 'Coro::Channel', 38 | default => sub { Coro::Channel -> new } 39 | ) ; 40 | 41 | has 'checker2_channel' => 42 | ( 43 | is => 'ro', 44 | isa => 'Coro::Channel', 45 | default => sub { Coro::Channel -> new } 46 | ) ; 47 | 48 | # --------------------------------------------------------------------------- 49 | 50 | sub _build_infile 51 | { 52 | my ($fh, $filename) = File::Temp::tempfile(); 53 | close $fh ; 54 | 55 | return $filename ; 56 | } 57 | 58 | # --------------------------------------------------------------------------- 59 | 60 | sub _build_outfile 61 | { 62 | my ($fh, $filename) = File::Temp::tempfile(); 63 | close $fh ; 64 | 65 | return $filename ; 66 | } 67 | 68 | 69 | # --------------------------------------------------------------------------- 70 | 71 | sub check_perl_syntax 72 | { 73 | my ($self, $workspace, $uri, $text) = @_ ; 74 | 75 | $self -> checker_channel -> put ([$uri, $text]) ; 76 | } 77 | 78 | 79 | # --------------------------------------------------------------------------- 80 | 81 | sub run_win32 82 | { 83 | my ($self, $text, $inc) = @_ ; 84 | 85 | 86 | return (0, undef, undef) ; # disable for now on windows 87 | 88 | my $infile = $self -> infile ; 89 | my $outfile = $self -> outfile ; 90 | 91 | print STDERR "infile=$infile outfile=$outfile\n" ; 92 | my $ifh = aio_open ($infile, IO::AIO::O_WRONLY | IO::AIO::O_TRUNC | IO::AIO::O_CREAT, 0600) or die "open $infile failed ($!)" ; 93 | aio_write ($ifh, undef, undef, $text, 0) ; 94 | aio_close ($ifh) ; 95 | 96 | print STDERR "run ", $self -> perlcmd . " -c @$inc $infile 2> $outfile", "\n" ; 97 | 98 | # use Win32::Process ; 99 | 100 | # my $cmd = $self -> perlcmd . " -c @$inc $infile" ; 101 | 102 | # print STDERR $cmd, "\n" ; 103 | 104 | # my $ProcessObj ; 105 | my $rc ; 106 | # Win32::Process::Create($ProcessObj, 107 | 108 | # $self -> perlcmd, 109 | # $cmd, 110 | # 0, 111 | # NORMAL_PRIORITY_CLASS, 112 | # "."); 113 | 114 | # print STDERR "wait\n" ; 115 | 116 | # $ProcessObj->Wait(5000) ; 117 | 118 | print STDERR "done\n" ; 119 | 120 | my $errout ; 121 | my $out ; 122 | aio_load ($outfile, $errout) ; 123 | print STDERR "errout = $errout\n" ; 124 | 125 | return ($rc, $out, $errout) ; 126 | } 127 | 128 | 129 | # --------------------------------------------------------------------------- 130 | 131 | sub run_system 132 | { 133 | my ($self, $text, $inc) = @_ ; 134 | 135 | my $infile = $self -> infile ; 136 | my $outfile = $self -> outfile ; 137 | 138 | local $SIG{CHLD} = 'DEFAULT' ; 139 | local $SIG{PIPE} = 'DEFAULT' ; 140 | 141 | print STDERR "infile=$infile outfile=$outfile\n" ; 142 | my $ifh = aio_open ($infile, IO::AIO::O_WRONLY | IO::AIO::O_TRUNC | IO::AIO::O_CREAT, 0600) or die "open $infile failed ($!)" ; 143 | aio_write ($ifh, undef, undef, $text, 0) ; 144 | aio_close ($ifh) ; 145 | 146 | print STDERR "run ", $self -> perlcmd . " -c @$inc $infile 2> $outfile", "\n" ; 147 | my $rc = system ($self -> perlcmd . " -c @$inc $infile 2> $outfile") ; 148 | print STDERR "done\n" ; 149 | 150 | my $errout ; 151 | my $out ; 152 | aio_load ($outfile, $errout) ; 153 | print STDERR "errout = $errout\n" ; 154 | 155 | return ($rc, $out, $errout) ; 156 | } 157 | 158 | # --------------------------------------------------------------------------- 159 | 160 | sub run_open3 161 | { 162 | my ($self, $text, $inc) = @_ ; 163 | 164 | #return (0, undef, undef) ; 165 | 166 | my($wtr, $rdr, $err); 167 | 168 | require IPC::Open3 ; 169 | use Symbol 'gensym'; $err = gensym; 170 | $self -> logger ("open3\n") if ($Perl::LanguageServer::debug2) ; 171 | my $pid = IPC::Open3::open3($wtr, $rdr, $err, $self -> perlcmd, '-c', @$inc) or die "Cannot run " . $self -> perlcmd ; 172 | $self -> logger ("write start pid=$pid\n") if ($Perl::LanguageServer::debug2) ; 173 | syswrite ($wtr, $text . "\n__END__\n") ; 174 | $self -> logger ("close start\n") if ($Perl::LanguageServer::debug2) ; 175 | close ($wtr) ; 176 | $self -> logger ("write done\n") if ($Perl::LanguageServer::debug2) ; 177 | 178 | my $out ; 179 | my $errout = join ('', <$err>) ; 180 | close $err ; 181 | close $rdr ; 182 | $self -> logger ("closed\n") if ($Perl::LanguageServer::debug2) ; 183 | waitpid( $pid, 0 ); 184 | my $rc = $? ; 185 | 186 | return ($rc, $out, $errout) ; 187 | } 188 | 189 | # --------------------------------------------------------------------------- 190 | 191 | sub background_checker 192 | { 193 | my ($self, $server) = @_ ; 194 | 195 | async 196 | { 197 | my $channel1 = $self -> checker_channel ; 198 | my $channel2 = $self -> checker2_channel ; 199 | 200 | my %timer ; 201 | while (my $cmd = $channel1 -> get) 202 | { 203 | my ($uri, $text) = @$cmd ; 204 | 205 | $timer{$uri} = AnyEvent->timer (after => 1.5, cb => sub 206 | { 207 | delete $timer{$uri} ; 208 | $channel2 -> put($cmd) ; 209 | }) ; 210 | } 211 | 212 | } ; 213 | 214 | my $channel = $self -> checker2_channel ; 215 | 216 | while (my $cmd = $channel -> get) 217 | { 218 | my ($uri, $text) = @$cmd ; 219 | 220 | $text = eval { Encode::encode ('utf-8', $text) ; } ; 221 | $self -> logger ($@) if ($@) ; 222 | 223 | my $fn = $uri ; 224 | $fn =~ s/^file:\/\/// ; 225 | $fn = $self -> file_client2server ($fn) ; 226 | $text = "local \$0; BEGIN { \$0 = '$fn'; if (\$INC{'FindBin.pm'}) { FindBin->again(); } }\n# line 1 \"$fn\"\n" . $text; 227 | 228 | my $ret ; 229 | my $errout ; 230 | my $out ; 231 | my $inc = $self -> perlinc ; 232 | my @inc ; 233 | @inc = map { ('-I', $_)} @$inc if ($inc) ; 234 | 235 | my @syntax_options ; 236 | if ($self -> use_taint_for_syntax_check) { 237 | @syntax_options = ('-T') ; 238 | } 239 | 240 | $self -> logger ("start perl @syntax_options -c @inc for $uri\n") if ($Perl::LanguageServer::debug1) ; 241 | if ($^O =~ /Win/) 242 | { 243 | # ($ret, $out, $errout) = $self -> run_open3 ($text, \@inc) ; 244 | ($ret, $out, $errout) = $self -> run_win32 ($text, \@inc) ; 245 | } 246 | else 247 | { 248 | $ret = run_cmd ([$self -> perlcmd, @syntax_options, '-c', @inc], 249 | "<", \$text, 250 | ">", \$out, 251 | "2>", \$errout) 252 | -> recv ; 253 | } 254 | 255 | my $rc = $ret >> 8 ; 256 | $self -> logger ("perl -c rc=$rc out=$out errout=$errout\n") if ($Perl::LanguageServer::debug1) ; 257 | 258 | my @messages ; 259 | if ($rc != 0) 260 | { 261 | my $line ; 262 | my @lines = split /\n/, $errout ; 263 | my $lineno = 0 ; 264 | my $filename ; 265 | my $lastline = 1 ; 266 | my $msg ; 267 | my $severity = 1 ; 268 | foreach $line (@lines) 269 | { 270 | $line =~ s/\s*$// ; 271 | #print STDERR $line, "\n" ; 272 | next if ($line =~ /had compilation errors/) ; 273 | $filename = $1 if ($line =~ /at (.+?) line (\d+)[,.]/) ; 274 | #print STDERR "line = $lineno file=$filename fn=$fn\n" ; 275 | $filename ||= $fn ; 276 | $lineno = $1 if ($line =~ / line (\d+)[,.]/) ; 277 | 278 | $msg .= $line ; 279 | if ($lineno) 280 | { 281 | push @messages, [$filename, $lineno, $severity, $msg] if ($msg) ; 282 | $lastline = $lineno ; 283 | $lineno = 0 ; 284 | $msg = '' ; 285 | } 286 | } 287 | } 288 | 289 | $self -> add_diagnostic_messages ($server, $uri, 'perl syntax', \@messages) ; 290 | } 291 | } 292 | 293 | 1; 294 | 295 | __END__ 296 | 297 | sub xxxx 298 | { 299 | 300 | my $infile = $self -> infile ; 301 | my $outfile = $self -> outfile ; 302 | 303 | print STDERR "infile=$infile outfile=$outfile\n" ; 304 | my $ifh = aio_open ($infile, IO::AIO::O_WRONLY | IO::AIO::O_TRUNC | IO::AIO::O_CREAT, 0600) or die "open $infile failed ($!)" ; 305 | aio_write ($ifh, undef, undef, $text, 0) ; 306 | aio_close ($ifh) ; 307 | 308 | # my $oldstderr ; 309 | # open($oldstderr, ">&", \*STDERR) or die "Can't dup STDERR: $!"; 310 | # open(STDERR, '>', $outfile) or die "Can't redirect STDERR: $!"; 311 | # print STDERR "start\n" ; 312 | # my $pid = spawnp "perl", ["perl", "-c", $infile]; 313 | # open(STDERR, ">&", $oldstderr) or die "Can't dup \$oldstderr: $!"; 314 | 315 | #my $pid = spawnp "cmd", ["cmd", '/C', "perl -c $infile 2> $outfile"]; 316 | my $pid = spawnp $workspace -> perlcmd, [$workspace -> perlcmd, ] 317 | 318 | print STDERR "pid=$pid\n" ; 319 | 320 | my $w = AnyEvent->child (pid => $pid, cb => rouse_cb) ; 321 | my $ret = rouse_wait ; 322 | undef $w ; 323 | #Coro::AnyEvent::sleep (1) ; 324 | #print STDERR "wait\n" ; 325 | #waitpid ($pid, 0) ; 326 | #my $ret = $? ; 327 | my $rc = $ret >> 8; 328 | print STDERR "perl -c rc=$rc\n" ; 329 | 330 | #aio_slurp ($outfile, 0, 0, $errout) ; 331 | aio_load ($outfile, $errout) ; 332 | print STDERR "errout = $errout\n" ; 333 | 334 | #return ; 335 | 336 | #my ($rc, $diags) = rouse_wait ; 337 | my $diags = [] ; 338 | 339 | print STDERR "---perl -c rc=$rc\n" ; 340 | 341 | return if ($rc == 0) ; 342 | 343 | my $result = 344 | { 345 | method => 'textDocument/publishDiagnostics', 346 | params => 347 | { 348 | uri => $uri, 349 | diagnostics => $diags, 350 | }, 351 | } ; 352 | 353 | $self -> send_notification ($result) ; 354 | } 355 | 356 | 357 | 358 | # my $cv = run_cmd [$workspace -> perlcmd, '-c'], 359 | # # "<", \$text, 360 | # "2>", \$errout 361 | # ; 362 | 363 | # $cv->cb (sub 364 | # { 365 | # shift->recv and die "perl -c failed"; 366 | 367 | # print "-------->$errout\n"; 368 | # }); 369 | 370 | # return ; 371 | 372 | AnyEvent::Util::fork_call (sub 373 | { 374 | print STDERR "open3 start c $$\n" ; 375 | IO::AIO::reinit ; 376 | 377 | my($wtr, $rdr, $err); 378 | 379 | #return ; 380 | 381 | # use Symbol 'gensym'; $err = gensym; 382 | my $pid = open3($wtr, $rdr, $err, $workspace -> perlcmd, '-c') or die "Cannot run " . $workspace -> perlcmd ; 383 | #cede () ; 384 | print STDERR "write start pid=$pid\n" ; 385 | syswrite ($wtr, $text . "\n__END__\n") ; 386 | print STDERR "close start\n" ; 387 | close ($wtr) ; 388 | print STDERR "write done\n" ; 389 | #my $errout = unblock $err ; 390 | my @diags ; 391 | my $line ; 392 | # while ($line = $errout -> readline) 393 | while ($line = <$rdr>) 394 | { 395 | $line =~ s/\s*$// ; 396 | print STDERR $line, "\n" ; 397 | next if ($line =~ /had compilation errors/) ; 398 | my $lineno = 0 ; 399 | $lineno = $1 if ($line =~ / line (\d+),/) ; 400 | my $diag = 401 | { 402 | # range: Range; 403 | # severity?: number; 404 | # code?: number | string; 405 | # source?: string; 406 | # message: string; 407 | # relatedInformation?: DiagnosticRelatedInformation[]; 408 | range => { start => { line => $lineno-1, character => 0 }, end => { line => $lineno+0, character => 0 }}, 409 | message => $line, 410 | } ; 411 | push @diags, $diag ; 412 | } 413 | 414 | print STDERR "EOF\n" ; 415 | 416 | waitpid( $pid, 0 ); 417 | my $rc = $? >> 8; 418 | print STDERR "perl -c rc=$rc\n" ; 419 | return ($rc, \@diags) ; 420 | }, rouse_cb ) ; 421 | 422 | my ($rc, $diags) = rouse_wait ; 423 | 424 | print STDERR "---perl -c rc=$rc\n" ; 425 | 426 | return if ($rc == 0) ; 427 | 428 | my $result = 429 | { 430 | method => 'textDocument/publishDiagnostics', 431 | params => 432 | { 433 | uri => $uri, 434 | diagnostics => $diags, 435 | }, 436 | } ; 437 | 438 | $self -> send_notification ($result) ; 439 | } 440 | 441 | 1 ; 442 | -------------------------------------------------------------------------------- /lib/Perl/LanguageServer/Workspace.pm: -------------------------------------------------------------------------------- 1 | package Perl::LanguageServer::Workspace ; 2 | 3 | use 5.006; 4 | use strict; 5 | use Moose ; 6 | 7 | use File::Basename ; 8 | use Coro ; 9 | use Coro::AIO ; 10 | use Data::Dump qw{dump} ; 11 | 12 | with 'Perl::LanguageServer::SyntaxChecker' ; 13 | with 'Perl::LanguageServer::Parser' ; 14 | 15 | no warnings 'uninitialized' ; 16 | 17 | # --------------------------------------------------------------------------- 18 | 19 | has 'config' => 20 | ( 21 | isa => 'HashRef', 22 | is => 'ro' 23 | ) ; 24 | 25 | has 'is_shutdown' => 26 | ( 27 | isa => 'Bool', 28 | is => 'rw', 29 | default => 0, 30 | ) ; 31 | 32 | has 'files' => 33 | ( 34 | isa => 'HashRef', 35 | is => 'rw', 36 | default => sub { {} }, 37 | ) ; 38 | 39 | has 'folders' => 40 | ( 41 | isa => 'HashRef', 42 | is => 'rw', 43 | default => sub { {} }, 44 | ) ; 45 | 46 | has 'symbols' => 47 | ( 48 | isa => 'HashRef', 49 | is => 'rw', 50 | default => sub { {} }, 51 | ) ; 52 | 53 | has 'path_map' => 54 | ( 55 | isa => 'Maybe[ArrayRef]', 56 | is => 'rw' 57 | ) ; 58 | 59 | has 'file_filter_regex' => 60 | ( 61 | isa => 'Str', 62 | is => 'rw', 63 | default => '(?:\.pm|\.pl)$', 64 | ) ; 65 | 66 | has 'ignore_dir' => 67 | ( 68 | isa => 'HashRef', 69 | is => 'rw', 70 | default => sub { { '.git' => 1, '.svn' => 1, '.vscode' => 1 } }, 71 | ) ; 72 | 73 | has 'perlcmd' => 74 | ( 75 | isa => 'Str', 76 | is => 'rw', 77 | default => $^X, 78 | ) ; 79 | 80 | has 'perlinc' => 81 | ( 82 | isa => 'Maybe[ArrayRef]', 83 | is => 'rw', 84 | ) ; 85 | 86 | has 'use_taint_for_syntax_check' => 87 | ( 88 | isa => 'Maybe[Bool]', 89 | is => 'rw' 90 | ) ; 91 | 92 | has 'show_local_vars' => 93 | ( 94 | isa => 'Maybe[Bool]', 95 | is => 'rw', 96 | ) ; 97 | 98 | 99 | has 'parser_channel' => 100 | ( 101 | is => 'rw', 102 | isa => 'Coro::Channel', 103 | default => sub { Coro::Channel -> new } 104 | ) ; 105 | 106 | has 'state_dir' => 107 | ( 108 | is => 'rw', 109 | isa => 'Str', 110 | lazy_build => 1, 111 | clearer => 'clear_state_dir', 112 | ) ; 113 | 114 | has 'disable_cache' => 115 | ( 116 | isa => 'Maybe[Bool]', 117 | is => 'rw', 118 | ) ; 119 | 120 | # --------------------------------------------------------------------------- 121 | 122 | sub logger 123 | { 124 | my $self = shift ; 125 | 126 | Perl::LanguageServer::logger (undef, @_) ; 127 | } 128 | 129 | # ---------------------------------------------------------------------------- 130 | 131 | 132 | sub mkpath 133 | { 134 | my ($self, $dir) = @_ ; 135 | 136 | aio_stat ($dir) ; 137 | if (! -d _) 138 | { 139 | $self -> mkpath (dirname($dir)) ; 140 | aio_mkdir ($dir, 0755) and die "Cannot make $dir ($!)" ; 141 | } 142 | } 143 | 144 | # --------------------------------------------------------------------------- 145 | 146 | sub _build_state_dir 147 | { 148 | my ($self) = @_ ; 149 | 150 | my $root = $self -> config -> {rootUri} || 'file:///tmp' ; 151 | my $rootpath = substr ($self -> uri_client2server ($root), 7) ; 152 | $rootpath =~ s#^/(\w)%3A/#$1:/# ; 153 | $rootpath .= '/.vscode/perl-lang' ; 154 | print STDERR "state_dir = $rootpath\n" ; 155 | $self -> mkpath ($rootpath) ; 156 | 157 | return $rootpath ; 158 | } 159 | 160 | # --------------------------------------------------------------------------- 161 | 162 | 163 | sub shutdown 164 | { 165 | my ($self) = @_ ; 166 | 167 | $self -> is_shutdown (1) ; 168 | } 169 | 170 | # --------------------------------------------------------------------------- 171 | 172 | sub uri_server2client 173 | { 174 | my ($self, $uri) = @_ ; 175 | 176 | my $map = $self -> path_map ; 177 | return $uri if (!$map) ; 178 | 179 | #print STDERR ">uri_server2client $uri\n", dump($map), "\n" ; 180 | foreach my $m (@$map) 181 | { 182 | last if ($uri =~ s/$m->[0]/$m->[1]/) ; 183 | } 184 | #print STDERR " path_map ; 196 | return $uri if (!$map) ; 197 | 198 | #print STDERR ">uri_client2server $uri\n" ; 199 | foreach my $m (@$map) 200 | { 201 | last if ($uri =~ s/$m->[1]/$m->[0]/) ; 202 | } 203 | #print STDERR " path_map ; 215 | return $fn if (!$map) ; 216 | 217 | foreach my $m (@$map) 218 | { 219 | #print STDERR "file_server2client $m->[2] -> $m->[3] : $fn\n" ; 220 | last if ($fn =~ s/$m->[2]/$m->[3]/) ; 221 | } 222 | 223 | return $fn ; 224 | } 225 | 226 | # --------------------------------------------------------------------------- 227 | 228 | sub file_client2server 229 | { 230 | my ($self, $fn, $map) = @_ ; 231 | 232 | $map ||= $self -> path_map ; 233 | return $fn if (!$map) ; 234 | 235 | $fn =~ s/\\/\//g ; 236 | 237 | foreach my $m (@$map) 238 | { 239 | #print STDERR "file_client2server $m->[3] -> $m->[2] : $fn\n" ; 240 | last if ($fn =~ s/$m->[3]/$m->[2]/) ; 241 | } 242 | 243 | return $fn ; 244 | } 245 | 246 | # --------------------------------------------------------------------------- 247 | 248 | sub set_workspace_folders 249 | { 250 | my ($self, $workspace_folders) = @_ ; 251 | 252 | my $folders = $self -> folders ; 253 | foreach my $ws (@$workspace_folders) 254 | { 255 | my $diruri = $self -> uri_client2server ($ws -> {uri}) ; 256 | 257 | my $dir = substr ($diruri, 7) ; 258 | $dir =~ s#^/(\w)%3A/#$1:/# ; 259 | $folders -> {$ws -> {uri}} = $dir ; 260 | } 261 | } 262 | 263 | # --------------------------------------------------------------------------- 264 | 265 | sub add_diagnostic_messages 266 | { 267 | my ($self, $server, $uri, $source, $messages, $version) = @_ ; 268 | 269 | my $files = $self -> files ; 270 | $files -> {$uri}{messages}{$source} = $messages ; 271 | $files -> {$uri}{messages_version} = $version if (defined ($version)); 272 | 273 | # make sure all old messages associated with this uri are cleaned up 274 | my %diags = ( map { $_ => [] } @{$files -> {$uri}{diags} } ) ; 275 | foreach my $src (keys %{$files -> {$uri}{messages}}) 276 | { 277 | my $msgs = $files -> {$uri}{messages}{$src} ; 278 | if ($msgs && @$msgs) 279 | { 280 | my $line ; 281 | my $lineno = 0 ; 282 | my $filename ; 283 | my $lastline = 1 ; 284 | my $msg ; 285 | my $severity ; 286 | foreach $line (@$msgs) 287 | { 288 | ($filename, $lineno, $severity, $msg) = @$line ; 289 | if ($lineno) 290 | { 291 | if ($msg) 292 | { 293 | my $diag = 294 | { 295 | # range: Range; 296 | # severity?: DiagnosticSeverity; 297 | # code?: number | string; 298 | # codeDescription?: CodeDescription; 299 | # source?: string; 300 | # message: string; 301 | # tags?: DiagnosticTag[]; 302 | # relatedInformation?: DiagnosticRelatedInformation[]; 303 | # data?: unknown; 304 | 305 | # DiagnosticSeverity 306 | # const Error: 1 = 1; 307 | # const Warning: 2 = 2; 308 | # const Information: 3 = 3; 309 | # const Hint: 4 = 4; 310 | 311 | # DiagnosticTag 312 | # * Clients are allowed to render diagnostics with this tag faded out 313 | # * instead of having an error squiggle. 314 | # export const Unnecessary: 1 = 1; 315 | # * Clients are allowed to rendered diagnostics with this tag strike through. 316 | # export const Deprecated: 2 = 2; 317 | 318 | # DiagnosticRelatedInformation 319 | # * Represents a related message and source code location for a diagnostic. 320 | # * This should be used to point to code locations that cause or are related to 321 | # * a diagnostics, e.g when duplicating a symbol in a scope. 322 | # 323 | # * The location of this related diagnostic information. 324 | # location: Location; 325 | # * The message of this related diagnostic information. 326 | # message: string; 327 | 328 | range => { start => { line => $lineno-1, character => 0 }, end => { line => $lineno+0, character => 0 }}, 329 | ($severity?(severity => $severity + 0):()), 330 | message => $msg, 331 | source => $src, 332 | } ; 333 | $diags{$filename} ||= [] ; 334 | push @{$diags{$filename}}, $diag ; 335 | } 336 | $lastline = $lineno ; 337 | $lineno = 0 ; 338 | $msg = '' ; 339 | } 340 | } 341 | } 342 | } 343 | $files -> {$uri}{diags} = [keys %diags] ; 344 | 345 | foreach my $filename (keys %diags) 346 | { 347 | my $fnuri = !$filename || $filename eq '-'?$uri:$self -> uri_server2client ('file://' . $filename) ; 348 | my $result = 349 | { 350 | method => 'textDocument/publishDiagnostics', 351 | params => 352 | { 353 | uri => $fnuri, 354 | diagnostics => $diags{$filename}, 355 | }, 356 | } ; 357 | 358 | $server -> send_notification ($result) ; 359 | } 360 | } 361 | 362 | # --------------------------------------------------------------------------- 363 | 364 | 365 | 1 ; 366 | 367 | -------------------------------------------------------------------------------- /t/00-load.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | 7 | plan tests => 1; 8 | 9 | BEGIN { 10 | use_ok( 'Perl::LanguageServer' ) || print "Bail out!\n"; 11 | } 12 | 13 | diag( "Testing Perl::LanguageServer $Perl::LanguageServer::VERSION, Perl $], $^X" ); 14 | -------------------------------------------------------------------------------- /t/manifest.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | 7 | unless ( $ENV{RELEASE_TESTING} ) { 8 | plan( skip_all => "Author tests not required for installation" ); 9 | } 10 | 11 | my $min_tcm = 0.9; 12 | eval "use Test::CheckManifest $min_tcm"; 13 | plan skip_all => "Test::CheckManifest $min_tcm required" if $@; 14 | 15 | ok_manifest(); 16 | -------------------------------------------------------------------------------- /t/pod-coverage.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | 7 | unless ( $ENV{RELEASE_TESTING} ) { 8 | plan( skip_all => "Author tests not required for installation" ); 9 | } 10 | 11 | # Ensure a recent version of Test::Pod::Coverage 12 | my $min_tpc = 1.08; 13 | eval "use Test::Pod::Coverage $min_tpc"; 14 | plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" 15 | if $@; 16 | 17 | # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, 18 | # but older versions don't recognize some common documentation styles 19 | my $min_pc = 0.18; 20 | eval "use Pod::Coverage $min_pc"; 21 | plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" 22 | if $@; 23 | 24 | all_pod_coverage_ok(); 25 | -------------------------------------------------------------------------------- /t/pod.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | use 5.006; 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | 7 | unless ( $ENV{RELEASE_TESTING} ) { 8 | plan( skip_all => "Author tests not required for installation" ); 9 | } 10 | 11 | # Ensure a recent version of Test::Pod 12 | my $min_tp = 1.22; 13 | eval "use Test::Pod $min_tp"; 14 | plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; 15 | 16 | all_pod_files_ok(); 17 | --------------------------------------------------------------------------------