Description="Perl"

Keywords={
  { Id=1,
    List={"if", "else", "elsif", "unless", "given", "when", "default", "while", "for", "foreach",
    "do", "until", "continue", "return", "last", "next", "redo", "goto", "break", "exit", "sub",
    "package", "use", "no", "dump", "require", "BEGIN", "CHECK", "INIT", "END", "UNITCHECK", 
    "NEXT", "loop", "class", "in" },
  },
  { Id=2,
    Regex=[[ [$@%]\#?\w+ ]],
  },
  { Id=3,
    List={"defined", "undef", "eq", "ne", "lt", "gt", "ge", "le", "cmp", "not", 
    "and", "or", "xor", "bless", "ref", "my", "our", "local", "state", "chomp", 
    "chop", "chr", "crypt", "index", "rindex", "lc", "lcfirst", "length", "ord", 
    "pack", "print", "printf", "sprintf", "substr", "uc",
    "ucfirst", "pos", "quotemeta", "split", "study", "abs", "atan2", "cos", 
    "exp", "hex", "int", "log", "oct", "rand", "sin", "sqrt", "srand", "splice", 
    "unshift", "shift", "push", "pop", "join", "reverse", "grep", "map", "sort", 
    "unpack", "pack", "delete", "each", "exists", "keys",
    "values", "syscall", "dbmopen", "dbmclose", "binmode", "close", "closedir", 
    "eof", "fileno", "getc", "stat", "lstat", "read", "readdir", "readline", "pipe", 
    "rewinddir", "say", "select", "tell", "telldir", "write", "fcntl", "flock", 
    "ioctl", "open", "opendir", "seek", "seekdir",
    "sysopen", "sysread", "sysseek", "syswrite", "truncate", "chdir", "chmod", 
    "chown", "chroot", "glob", "link", "mkdir", "readlink", "rename", "rmdir", "symlink", 
    "umask", "unlink", "utime", "caller", "die", "wantarray", "vec", "alarm", 
    "exec", "fork", "getpgrp", "getppid", "getpriority", "kill", "pipe", "setpgrp", 
    "setpriority", "sleep", "system", "times", "wait", "waitpid", "accept", "bind", 
    "connect", "getpeername", "getsockname",
    "getsockopt", "listen", "recv", "send", "setsockopt", "shutdown", "socket", 
    "socketpair", "msgctl", "msgget", "msgrcv", "msgsnd", "semctl", "semget", 
    "semop", "shmctl", "shmget", "shmread", "shmwrite", "gethostent", "getnetent", 
    "getprotoent", "getservent", "setpwent",
    "setgrent", "sethostent", "setnetent", "setprotoent", "setservent", 
    "endpwent", "endgrent", "endhostent", "endnetent", "endprotoent", "endservent", 
    "gethostbyaddr", "gethostbyname", "getnetbyaddr", "getnetbyname", 
    "getprotobyname", "getprotobynumber", "getservbyname",
    "getservbyport", "getpwuid", "getpwnam", "getgrgid", "getgrnam", "getlogin", 
    "getpwent", "getgrent", "gmtime", "localtime", "time", "warn", "formline", 
    "reset", "scalar", "prototype", "lock", "tied", "untie", "qq", "qx", "eval" },
  },
  { Id=4,
	Regex=[[->([a-zA-Z0-9_]+)]],
	Group=1,
  },
  
  --# Still only covers more common usage but by far not all
    -- see OnStateChange below
  { Id=4,
    Regex=[[\/.*?\/[msixpodualgc]*|m\/.*?\/[msixpodualgc]*|qr\/.*?\/[msixpodual]*|s\/.*?\/.*?\/[msixpodualgcer]*|(?:tr|y)\/.*?\/.*?\/[cdsr]*|m!.*?![msixpodualgc]*|qr!.*?![msixpodual]*|s!.*?!.*?![msixpodualgcer]*|(?:tr|y)!.*?!.*?![cdsr]*|m\?.*?\?[msixpodualgc]*|m\{.*?\}[msixpodualgc]*|qr\{.*?\}[msixpodual]*|s\{.*?\}\s*\{.*?\}[msixpodualgcer]*|(?:tr|y)\{.*?\}\s*\{.*?\}[cdsr]*]],
    Group=0
  },
  
   { Id=4,
    Regex=[[q[qxwr]?\{|qw\(]]
  },
}

-- hereDoc opening delimiter, see OnStateChange to handle end of string
-- do not allow digits as heredoc delimiters
Strings={
  Delimiter=[=["|'|`|<<["']?[[:alpha:]]+["']?]=],
  Interpolation=[[ [@\$%]\w+ ]],
  
}

IgnoreCase=false

Comments={
  { Block=true,
    Nested=false,
    Delimiter = { [[(?:^=pod|^=head[1234]|^=over|^=item|^=back|^=begin|^=end|^=for|^=encoding)]], [[^=cut\s*\Z]] }  },
  { Block=false,
    Delimiter= { [[(?<!\\)#]] },
  },
}

Operators=[[\(|\)|\[|\]|\{|\}|\,|\;|\:|\&|<|>|\!|~|\=|\/|\*|\+|\-|\$|\.|\^|\~|\%|\|]]

-- fix recognition of $ and other Perl perversions
function OnStateChange(oldState, newState, token, groupID)

   -- resolve issue with regex expression which spans strings like "</i>" + VAR + "</i>"
   if string.sub(token,1,1)=="/" and oldState==HL_STRING and newState==HL_KEYWORD and groupID == 4 then
      return HL_REJECT
   end

   if  (string.sub(token,1,1) =="$" or string.sub(token,1,1) =="@" or string.sub(token,1,1) =="%") and oldState==HL_STRING and newState==HL_KEYWORD then
      return HL_INTERPOLATION
   end
   
   --recognize hereDoc multine strings
   --do not clear hereDoc if token is ",' or `
   if (oldState==HL_STANDARD or oldState==HL_STRING) and newState==HL_STRING  and not string.find("\"'`", token) then
      hereDoc = string.match(token, "<<'?\"?(%a+)" )
   end
   
   if oldState==HL_STRING and token==hereDoc then
      hereDoc = nil
      return HL_STRING_END
   end
  
  -- fix issue in CGI.pm testcase (line 1060 ff)
   if oldState~=HL_STRING  then
      qString=0
    end
    
   if newState==HL_KEYWORD and token=="q{" then
      qString=1
      return HL_STRING
   end
 
   if newState==HL_KEYWORD and token=="qw(" then
      qString=2
      return HL_STRING
   end
 
   if oldState==HL_STRING and qString==1 and token=="}" then
      qString=0
      return HL_STRING_END
   end
   
   if oldState==HL_STRING and qString==2 and token==")" then
      qString=0
      return HL_STRING_END
   end
  
   
   return newState
end