| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241 |
- /**
- * @param {string} value
- * @returns {RegExp}
- * */
- /**
- * @param {RegExp | string } re
- * @returns {string}
- */
- function source(re) {
- if (!re) return null;
- if (typeof re === "string") return re;
- return re.source;
- }
- /**
- * @param {...(RegExp | string) } args
- * @returns {string}
- */
- function concat(...args) {
- const joined = args.map((x) => source(x)).join("");
- return joined;
- }
- /*
- Language: Perl
- Author: Peter Leonov <gojpeg@yandex.ru>
- Website: https://www.perl.org
- Category: common
- */
- /** @type LanguageFn */
- function perl(hljs) {
- // https://perldoc.perl.org/perlre#Modifiers
- const REGEX_MODIFIERS = /[dualxmsipn]{0,12}/; // aa and xx are valid, making max length 12
- const PERL_KEYWORDS = {
- $pattern: /[\w.]+/,
- keyword: 'getpwent getservent quotemeta msgrcv scalar kill dbmclose undef lc ' +
- 'ma syswrite tr send umask sysopen shmwrite vec qx utime local oct semctl localtime ' +
- 'readpipe do return format read sprintf dbmopen pop getpgrp not getpwnam rewinddir qq ' +
- 'fileno qw endprotoent wait sethostent bless s|0 opendir continue each sleep endgrent ' +
- 'shutdown dump chomp connect getsockname die socketpair close flock exists index shmget ' +
- 'sub for endpwent redo lstat msgctl setpgrp abs exit select print ref gethostbyaddr ' +
- 'unshift fcntl syscall goto getnetbyaddr join gmtime symlink semget splice x|0 ' +
- 'getpeername recv log setsockopt cos last reverse gethostbyname getgrnam study formline ' +
- 'endhostent times chop length gethostent getnetent pack getprotoent getservbyname rand ' +
- 'mkdir pos chmod y|0 substr endnetent printf next open msgsnd readdir use unlink ' +
- 'getsockopt getpriority rindex wantarray hex system getservbyport endservent int chr ' +
- 'untie rmdir prototype tell listen fork shmread ucfirst setprotoent else sysseek link ' +
- 'getgrgid shmctl waitpid unpack getnetbyname reset chdir grep split require caller ' +
- 'lcfirst until warn while values shift telldir getpwuid my getprotobynumber delete and ' +
- 'sort uc defined srand accept package seekdir getprotobyname semop our rename seek if q|0 ' +
- 'chroot sysread setpwent no crypt getc chown sqrt write setnetent setpriority foreach ' +
- 'tie sin msgget map stat getlogin unless elsif truncate exec keys glob tied closedir ' +
- 'ioctl socket readlink eval xor readline binmode setservent eof ord bind alarm pipe ' +
- 'atan2 getgrent exp time push setgrent gt lt or ne m|0 break given say state when'
- };
- const SUBST = {
- className: 'subst',
- begin: '[$@]\\{',
- end: '\\}',
- keywords: PERL_KEYWORDS
- };
- const METHOD = {
- begin: /->\{/,
- end: /\}/
- // contains defined later
- };
- const VAR = {
- variants: [
- {
- begin: /\$\d/
- },
- {
- begin: concat(
- /[$%@](\^\w\b|#\w+(::\w+)*|\{\w+\}|\w+(::\w*)*)/,
- // negative look-ahead tries to avoid matching patterns that are not
- // Perl at all like $ident$, @ident@, etc.
- `(?![A-Za-z])(?![@$%])`
- )
- },
- {
- begin: /[$%@][^\s\w{]/,
- relevance: 0
- }
- ]
- };
- const STRING_CONTAINS = [
- hljs.BACKSLASH_ESCAPE,
- SUBST,
- VAR
- ];
- const PERL_DEFAULT_CONTAINS = [
- VAR,
- hljs.HASH_COMMENT_MODE,
- hljs.COMMENT(
- /^=\w/,
- /=cut/,
- {
- endsWithParent: true
- }
- ),
- METHOD,
- {
- className: 'string',
- contains: STRING_CONTAINS,
- variants: [
- {
- begin: 'q[qwxr]?\\s*\\(',
- end: '\\)',
- relevance: 5
- },
- {
- begin: 'q[qwxr]?\\s*\\[',
- end: '\\]',
- relevance: 5
- },
- {
- begin: 'q[qwxr]?\\s*\\{',
- end: '\\}',
- relevance: 5
- },
- {
- begin: 'q[qwxr]?\\s*\\|',
- end: '\\|',
- relevance: 5
- },
- {
- begin: 'q[qwxr]?\\s*<',
- end: '>',
- relevance: 5
- },
- {
- begin: 'qw\\s+q',
- end: 'q',
- relevance: 5
- },
- {
- begin: '\'',
- end: '\'',
- contains: [ hljs.BACKSLASH_ESCAPE ]
- },
- {
- begin: '"',
- end: '"'
- },
- {
- begin: '`',
- end: '`',
- contains: [ hljs.BACKSLASH_ESCAPE ]
- },
- {
- begin: /\{\w+\}/,
- contains: [],
- relevance: 0
- },
- {
- begin: '-?\\w+\\s*=>',
- contains: [],
- relevance: 0
- }
- ]
- },
- {
- className: 'number',
- begin: '(\\b0[0-7_]+)|(\\b0x[0-9a-fA-F_]+)|(\\b[1-9][0-9_]*(\\.[0-9_]+)?)|[0_]\\b',
- relevance: 0
- },
- { // regexp container
- begin: '(\\/\\/|' + hljs.RE_STARTERS_RE + '|\\b(split|return|print|reverse|grep)\\b)\\s*',
- keywords: 'split return print reverse grep',
- relevance: 0,
- contains: [
- hljs.HASH_COMMENT_MODE,
- {
- className: 'regexp',
- begin: concat(
- /(s|tr|y)/,
- /\//,
- /(\\.|[^\\\/])*/,
- /\//,
- /(\\.|[^\\\/])*/,
- /\//,
- REGEX_MODIFIERS
- ),
- relevance: 10
- },
- {
- className: 'regexp',
- begin: /(m|qr)?\//,
- end: concat(
- /\//,
- REGEX_MODIFIERS
- ),
- contains: [ hljs.BACKSLASH_ESCAPE ],
- relevance: 0 // allows empty "//" which is a common comment delimiter in other languages
- }
- ]
- },
- {
- className: 'function',
- beginKeywords: 'sub',
- end: '(\\s*\\(.*?\\))?[;{]',
- excludeEnd: true,
- relevance: 5,
- contains: [ hljs.TITLE_MODE ]
- },
- {
- begin: '-\\w\\b',
- relevance: 0
- },
- {
- begin: "^__DATA__$",
- end: "^__END__$",
- subLanguage: 'mojolicious',
- contains: [
- {
- begin: "^@@.*",
- end: "$",
- className: "comment"
- }
- ]
- }
- ];
- SUBST.contains = PERL_DEFAULT_CONTAINS;
- METHOD.contains = PERL_DEFAULT_CONTAINS;
- return {
- name: 'Perl',
- aliases: [
- 'pl',
- 'pm'
- ],
- keywords: PERL_KEYWORDS,
- contains: PERL_DEFAULT_CONTAINS
- };
- }
- module.exports = perl;
|