12486: new completion caching layer

7 files changed, 395 insertions, 244 deletions

diff --git a/Completion/Base/.distfiles b/Completion/Base/.distfiles
index a906bfc76..0cbe1f97f 100644
--- a/Completion/Base/.distfiles
+++ b/Completion/Base/.distfiles
@@ -1,7 +1,7 @@
 DISTFILES_SRC='
     .distfiles 
-    _arg_compile _arguments _brace_parameter _combination
+    _arg_compile _arguments _brace_parameter _cache_invalid _combination
     _command_names _condition _default _describe _equal _first _in_vared
-    _jobs _math _parameter _precommand _redirect _regex_arguments _subscript
-    _tilde _value _values
+    _jobs _math _parameter _precommand _redirect _regex_arguments
+    _retrieve_cache _store_cache _subscript _tilde _value _values
 '
diff --git a/Completion/Base/_cache_invalid b/Completion/Base/_cache_invalid
new file mode 100644
index 000000000..e55381439
--- /dev/null
+++ b/Completion/Base/_cache_invalid
@@ -0,0 +1,21 @@
+#autoload
+#
+# Function to decide whether a completions cache needs rebuilding
+
+local _cache_ident _cache_dir _cache_path _cache_policy
+_cache_ident="$1"
+
+# If the cache is disabled, we never want to rebuild it, so pretend
+# it's valid.
+zstyle -t ":completion:${curcontext}:" use-cache || return 1
+
+zstyle -s ":completion:${curcontext}:" cache-path _cache_dir
+: ${_cache_dir:=${ZDOTDIR:-$HOME}/.zcompcache}
+_cache_path="$_cache_dir/$_cache_ident"
+
+# See whether the caching policy says that the cache needs rebuilding
+# (the policy will return 0 if it does).
+zstyle -s ":completion:${curcontext}:" cache-policy _cache_policy
+[[ -n "$_cache_policy" ]] && "$_cache_policy" "$_cache_path" && return 0
+
+return 1
diff --git a/Completion/Base/_retrieve_cache b/Completion/Base/_retrieve_cache
new file mode 100644
index 000000000..6a82cd48b
--- /dev/null
+++ b/Completion/Base/_retrieve_cache
@@ -0,0 +1,31 @@
+#autoload
+#
+# Retrieval component of completions caching layer
+
+local _cache_ident _cache_dir _cache_path _cache_policy
+_cache_ident="$1"
+
+if zstyle -t ":completion:${curcontext}:" use-cache; then
+  # Decide which directory to retrieve cache from, and ensure it exists
+  zstyle -s ":completion:${curcontext}:" cache-path _cache_dir
+  : ${_cache_dir:=${ZDOTDIR:-HOME}/.zcompcache}
+  if [[ ! -d "$_cache_dir" ]]; then
+    [[ -e "$_cache_dir" ]] &&
+      _message "cache-dir ($_cache_dir) isn't a directory\!"
+    return 1
+  fi
+
+  _cache_path="$_cache_dir/$_cache_ident"
+
+  if [[ -e "$_cache_path" ]]; then
+    _cache_invalid "$_cache_ident" && return 1
+
+    . "$_cache_path"
+    return 0
+  else
+    return 1
+  fi
+else
+  return 1
+fi
+
diff --git a/Completion/Base/_store_cache b/Completion/Base/_store_cache
new file mode 100644
index 000000000..2fe7dfcb6
--- /dev/null
+++ b/Completion/Base/_store_cache
@@ -0,0 +1,36 @@
+#autoload
+#
+# Storage component of completions caching layer
+
+local _cache_ident
+_cache_ident="$1"
+
+if zstyle -t ":completion:${curcontext}:" use-cache; then
+  # Decide which directory to cache to, and ensure it exists
+  zstyle -s ":completion:${curcontext}:" cache-path _cache_dir
+  : ${_cache_dir:=${ZDOTDIR:-$HOME}/.zcompcache}
+  if [[ ! -d "$_cache_dir" ]]; then
+    if [[ -e "$_cache_dir" ]]; then
+      _message "cache-dir style points to a non-directory\!"
+    else
+      mkdir -p "$_cache_dir"
+      if [[ ! -d "$_cache_dir" ]]; then
+        _message "Couldn't create cache-dir $_cache_dir"
+        return 1
+      fi
+    fi
+  fi
+
+  shift
+  for var; do
+    case ${(Pt)var} in
+    (*readonly*) ;;
+    (*(association|array)*) print -r "$var=( ${(kv@Pqq)^^var} )";;
+    (*)                     print -r "$var=${(Pqq)^^var}";;
+    esac
+  done >! "$_cache_dir/$_cache_ident"
+else
+  return 1
+fi
+
+return 0
diff --git a/Completion/Builtins/_zstyle b/Completion/Builtins/_zstyle
index fefa8af51..abfec06d3 100644
--- a/Completion/Builtins/_zstyle
+++ b/Completion/Builtins/_zstyle
@@ -15,6 +15,7 @@ styles=(
   assign-list            c:
   auto-description	 c:
   break-keys             c:
+  cache-path		 'c:_wanted directories expl directory _path_files -/'
   command                c:command
   completer		 c:completer
   completions		 c:bool
@@ -80,6 +81,7 @@ styles=(
   suffix		 c:bool
   tag-order		 c:tag
   try-to-use-pminst	 c:bool
+  use-cache		 c:bool
   use-compctl		 c:urgh
   users			 c:_users
   users-hosts		 c:user-host
diff --git a/Completion/Linux/_rpm b/Completion/Linux/_rpm
index e047af6d6..11bb370b8 100644
--- a/Completion/Linux/_rpm
+++ b/Completion/Linux/_rpm
@@ -41,213 +41,238 @@
 
 # Used by `_arguments', made local here.
 
-local curcontext="$curcontext" state lstate line nm="$compstate[nmatches]"
-typeset -A opt_args
-
-state=''
-
-local ret=1
-local -a tmp expl commonopts packageopts
-commonopts=(
-  '*-v[verbose mode]'
-  '--rcfile:resource file:_files'
-  '--ftpproxy:FTP proxy server:_hosts'
-  '--ftpport:FTP port number:'
-  '--httpproxy:HTTP proxy server:_hosts'
-  '--httpport:HTTP port number:'
-)
-packageopts=(
-  '-a[query all packages]'
-  '-p+[query uninstalled package file]:*:RPM package file:->package_file'
-  '-f[specify file to query owner of]:file:_files'
-  '--triggeredby:RPM package:->package'
-  '--whatprovides:RPM capability:->capability'
-  '--whatrequires:RPM capability:->capability'
-)
-pathopts=(
-  '--root:RPM root directory:_files -/'
-  '--dbpath:RPM database path:_files -/'
-)
-
-# Do simple completions or get the first state.
-
-_arguments -C -s \
-  '--help[print help message]' \
-  '--version[print version number]' \
-  "${commonopts[@]}" \
-  '-q+[query mode]:*:query:->query' \
-  --{querytags,initdb,showrc} \
-  '--pipe:pipe command:_command_names -e' \
-  -{V,y}'[verify mode]:*:verify:->verify' \
-  '--verify[verify mode]:*:verify:->verify' \
-  '--setperms[set file permissions]:*:package:->setattrs' \
-  '--setugids[set file owner/group]:*:package:->setattrs' \
-  '(--install)-i+[install mode]:*:install:->install' \
-  '(-i)--install:*:install:->install' \
-  '(--upgrade)-U+[upgrade mode]:*:upgrade:->upgrade' \
-  '(-U)--upgrade:*:upgrade:->upgrade' \
-  '(--freshen)-F+[freshen mode]:*:upgrade:->upgrade' \
-  '(-F)--freshen:*:upgrade:->upgrade' \
-  '(--erase)-e+[uninstall mode]:*:uninstall:->uninstall' \
-  '(-e)--erase:*:uninstall:->uninstall' \
-  '-b+[build mode (spec file)]:build stage:((p\:execute\ \%prep\ stage l\:do\ a\ list\ check c\:execute\ build\ stage i\:execute\ install\ stage b\:build\ a\ binary\ package a\:build\ binary\ and\ source\ packages)):*:build:->build_b' \
-  '(-b)-t+[build mode (tar file)]:build stage:((p\:execute\ \%prep\ stage l\:do\ a\ list\ check c\:execute\ build\ stage i\:execute\ install\ stage b\:build\ a\ binary\ package a\:build\ binary\ and\ source\ packages)):*:build:->build_t' \
-  --{resign,addsign}':*:RPM package:->package_file' \
-  '--rmsource:*:spec file:->spec_file' \
-  --{rebuild,recompile}':*:Src RPM files:->package_src' \
-  '(--checksig)-K+[signature check mode]:*:sigcheck:->sigcheck' \
-  '(-K)--checksig:*:sigcheck:->sigcheck' \
-  '--rebuilddb:*:rebuild:->rebuild' && ret=0
-
-# As long as we have a state name...
-
-while [[ -n "$state" ]]; do
-
-  # First try to call a user-defined function.
-
-  _funcall ret _rpm_$state && return ret
-
-  # Copy the state and reset `state', to simplify the test above.
-
-  lstate="$state"
+_rpm () {
+  local curcontext="$curcontext" state lstate line nm="$compstate[nmatches]"
+  typeset -A opt_args
+  
   state=''
-  tmp=()
-
-  # Dispatch...
-
-  case "$lstate" in
-  query)
-    # --dump requires on of -{l,c,d}
-    # --triggers requires --script
-    _arguments -s \
-      -q "${commonopts[@]}" "${packageopts[@]}" "${pathopts[@]}" \
-      '--queryformat:RPM query format:->tags' \
-      '-i[display package information]' \
-      '--changelog[display change log]' \
-      '-l[display package file list]' \
-      '-s[show file states]' \
-      '-d[documentation files only]' \
-      '-c[configuration files only]' \
-      '--dump[show all information]' \
-      --provides \
-      -{R,-requires}'[list dependencies]' \
-      '--scripts[show (un)install scripts]' \
-      '--triggers[show trigger scripts]' \
-      '*:RPM package:->package_or_file' && ret=0
-    ;;
-  setattrs)
-    _arguments -s --set{perm,ugids} "${packageopts[@]}" && ret = 0
-    ;;
-  verify)
-    _arguments -s \
-      '(-y --verify)-V' '(-V --verify)-y' '(-y -V)--verify' \
-      "${commonopts[@]}" "${pathopts[@]}" \
-      --no{deps,md5,files} \
-      '*:RPM package:->package' && ret=0
-    ;;
-  upgrade)
-    tmp=( '(--upgrade)-U' '(-U)--upgrade' '(--force)--oldpackage' )
-    ;&
-  install)
-    (( $#tmp )) || tmp=( '(--install)-i' '(-i)--install' )
-    _arguments -s "$tmp[@]" \
-      "${commonopts[@]}" "${pathopts[@]}" \
-      '--excludepath:exclude files in following path:_files -/' \
-      '--relocate:relocate:->relocate' \
-      '--prefix:package prefix directory:_files -/' \
-      '(-h)--hash' '(--hash)-h' \
-      '(--replacepkgs --replacefiles --oldpackage)--force' \
-      '(--force)--'{replacefiles,replacepkgs} \
-      --{badreloc,excludedocs,allfiles,ignorearch,ignoreos,includedocs,justdb,nodeps,noorder,noscripts,notriggers,percent,test} \
-      '*:pkg file:->package_file' && ret=0
-    ;;
-  uninstall)
-    _arguments -s \
-      '(-e)--erase' '(--erase)-e' \
-      "${commonopts[@]}" "${pathopts[@]}" \
-      --{allmatches,justdb,nodeps,noorder,noscripts,notriggers} \
-      '*:RPM package:->package' && ret=0
-    ;;
-  build_b)
-    tmp=( '*:spec file:_files -g \*.spec' )
-    ;&
-  build_t)
-    (( $#tmp )) || tmp=( '*:tar file:_files -g \*.\(\#i\)tar\(.\*\|\)' )
+  
+  local ret=1
+  local -a tmp expl commonopts packageopts
+  commonopts=(
+    '*-v[verbose mode]'
+    '--rcfile:resource file:_files'
+    '--ftpproxy:FTP proxy server:_hosts'
+    '--ftpport:FTP port number:'
+    '--httpproxy:HTTP proxy server:_hosts'
+    '--httpport:HTTP port number:'
+  )
+  packageopts=(
+    '-a[query all packages]'
+    '-p+[query uninstalled package file]:*:RPM package file:->package_file'
+    '-f[specify file to query owner of]:file:_files'
+    '--triggeredby:RPM package:->package'
+    '--whatprovides:RPM capability:->capability'
+    '--whatrequires:RPM capability:->capability'
+  )
+  pathopts=(
+    '--root:RPM root directory:_files -/'
+    '--dbpath:RPM database path:_files -/'
+  )
+  
+  # Do simple completions or get the first state.
+  
+  _arguments -C -s \
+    '--help[print help message]' \
+    '--version[print version number]' \
+    "${commonopts[@]}" \
+    '-q+[query mode]:*:query:->query' \
+    --{querytags,initdb,showrc} \
+    '--pipe:pipe command:_command_names -e' \
+    -{V,y}'[verify mode]:*:verify:->verify' \
+    '--verify[verify mode]:*:verify:->verify' \
+    '--setperms[set file permissions]:*:package:->setattrs' \
+    '--setugids[set file owner/group]:*:package:->setattrs' \
+    '(--install)-i+[install mode]:*:install:->install' \
+    '(-i)--install:*:install:->install' \
+    '(--upgrade)-U+[upgrade mode]:*:upgrade:->upgrade' \
+    '(-U)--upgrade:*:upgrade:->upgrade' \
+    '(--freshen)-F+[freshen mode]:*:upgrade:->upgrade' \
+    '(-F)--freshen:*:upgrade:->upgrade' \
+    '(--erase)-e+[uninstall mode]:*:uninstall:->uninstall' \
+    '(-e)--erase:*:uninstall:->uninstall' \
+    '-b+[build mode (spec file)]:build stage:((p\:execute\ \%prep\ stage l\:do\ a\ list\ check c\:execute\ build\ stage i\:execute\ install\ stage b\:build\ a\ binary\ package a\:build\ binary\ and\ source\ packages)):*:build:->build_b' \
+    '(-b)-t+[build mode (tar file)]:build stage:((p\:execute\ \%prep\ stage l\:do\ a\ list\ check c\:execute\ build\ stage i\:execute\ install\ stage b\:build\ a\ binary\ package a\:build\ binary\ and\ source\ packages)):*:build:->build_t' \
+    --{resign,addsign}':*:RPM package:->package_file' \
+    '--rmsource:*:spec file:->spec_file' \
+    --{rebuild,recompile}':*:Src RPM files:->package_src' \
+    '(--checksig)-K+[signature check mode]:*:sigcheck:->sigcheck' \
+    '(-K)--checksig:*:sigcheck:->sigcheck' \
+    '--rebuilddb:*:rebuild:->rebuild' && ret=0
+  
+  # As long as we have a state name...
+  
+  while [[ -n "$state" ]]; do
+  
+    # First try to call a user-defined function.
+  
+    _funcall ret _rpm_$state && return ret
+  
+    # Copy the state and reset `state', to simplify the test above.
+  
+    lstate="$state"
+    state=''
+    tmp=()
+  
+    # Dispatch...
+  
+    case "$lstate" in
+    query)
+      # --dump requires on of -{l,c,d}
+      # --triggers requires --script
+      _arguments -s \
+        -q "${commonopts[@]}" "${packageopts[@]}" "${pathopts[@]}" \
+        '--queryformat:RPM query format:->tags' \
+        '-i[display package information]' \
+        '--changelog[display change log]' \
+        '-l[display package file list]' \
+        '-s[show file states]' \
+        '-d[documentation files only]' \
+        '-c[configuration files only]' \
+        '--dump[show all information]' \
+        --provides \
+        -{R,-requires}'[list dependencies]' \
+        '--scripts[show (un)install scripts]' \
+        '--triggers[show trigger scripts]' \
+        '*:RPM package:->package_or_file' && ret=0
+      ;;
+    setattrs)
+      _arguments -s --set{perm,ugids} "${packageopts[@]}" && ret = 0
+      ;;
+    verify)
+      _arguments -s \
+        '(-y --verify)-V' '(-V --verify)-y' '(-y -V)--verify' \
+        "${commonopts[@]}" "${pathopts[@]}" \
+        --no{deps,md5,files} \
+        '*:RPM package:->package' && ret=0
+      ;;
+    upgrade)
+      tmp=( '(--upgrade)-U' '(-U)--upgrade' '(--force)--oldpackage' )
+      ;&
+    install)
+      (( $#tmp )) || tmp=( '(--install)-i' '(-i)--install' )
+      _arguments -s "$tmp[@]" \
+        "${commonopts[@]}" "${pathopts[@]}" \
+        '--excludepath:exclude files in following path:_files -/' \
+        '--relocate:relocate:->relocate' \
+        '--prefix:package prefix directory:_files -/' \
+        '(-h)--hash' '(--hash)-h' \
+        '(--replacepkgs --replacefiles --oldpackage)--force' \
+        '(--force)--'{replacefiles,replacepkgs} \
+        --{badreloc,excludedocs,allfiles,ignorearch,ignoreos,includedocs,justdb,nodeps,noorder,noscripts,notriggers,percent,test} \
+        '*:pkg file:->package_file' && ret=0
+      ;;
+    uninstall)
+      _arguments -s \
+        '(-e)--erase' '(--erase)-e' \
+        "${commonopts[@]}" "${pathopts[@]}" \
+        --{allmatches,justdb,nodeps,noorder,noscripts,notriggers} \
+        '*:RPM package:->package' && ret=0
+      ;;
+    build_b)
+      tmp=( '*:spec file:_files -g \*.spec' )
+      ;&
+    build_t)
+      (( $#tmp )) || tmp=( '*:tar file:_files -g \*.\(\#i\)tar\(.\*\|\)' )
+  
+      _arguments -s \
+        "${commonopts[@]}" "${pathopts[@]}" \
+        --{short-circuit,clean,rmsource,sign,test} \
+        '--target:specify a build target:->target'\
+        '--buildroot:build root directory:_files -/' \
+        '--buildarch:architecture for which to build:->target' \
+        '--buildos:ositecture for which to build:' \
+        '--timecheck:time check (seconds):' "$tmp[1]" && ret=0
+      ;;
+    sigcheck)
+      _arguments -s \
+        '(-K)--checksig' '(--checksig)-K' \
+        "${commonopts[@]}" \
+        --no{pgp,md5} \
+        '*:RPM package file:->package_file' && ret=0
+      ;;
+    rebuild)
+      _arguments -s \
+        "${commonopts[@]}" "${pathopts[@]}" \
+        '*:RPM source package file:->package_file' && ret=0
+      ;;
+    target)
+      _wanted target expl 'Target platforms' \
+          compadd $(_call target rpm --showrc 2> /dev/null |grep 'compatible archs'|sed 's/.*: //') && ret=0
+      ;;
+    package_or_file)
+      state=package_file
+      ;&
+    package)
+      if ( [[ ${+_rpms} -eq 0 ]] || _cache_invalid RPMs ) &&
+         ! _retrieve_cache RPMs;
+      then
+        _rpms=( $(_call packages rpm -qa 2>/dev/null) )
+        _store_cache RPMs _rpms
+      fi
+      _wanted packages expl 'RPM package' \
+          compadd -M 'r:|-=* r:|=*' - "$_rpms[@]" && ret=0
+      ;;
+    spec_file)
+      _wanted specfiles expl 'spec file' \
+          _files -g \*.spec && ret=0
+      ;;
+    package_file)
+      _wanted files expl 'RPM package file' \
+          _files -g '*.(#i)rpm' && ret=0
+      if [[ -prefix 1 (f|ht)tp:// ]]; then
+        _wanted urls expl 'URL of RPM package file' \
+            _urls -f -g '*.(#i)rpm' "${expl[@]}" && ret=0
+      else
+        _wanted urls expl 'URL of RPM package file' \
+            compadd -S '' "${expl[@]}" ftp:// http:// && ret=0
+      fi
+      ;;
+    package_src)
+      _files -g \*.src\(\#i\).rpm
+     ;&
+    tags)
+      if compset -P '*%*\{'; then
+        _wanted tags expl 'RPM tag' \
+            compadd -M 'm:{a-z}={A-Z}' -S '\}' - \
+                    "${(@)${(@f)$(_call tags rpm --querytags 2> /dev/null)}#RPMTAG_}" && ret=0
+      else
+        _message 'RPM format'
+      fi
+      ;;
+    capability)
+      _message 'RPM capability'
+      ;;
+    relocate)
+      if compset -P '*='; then
+        _description directories expl 'new path'
+      else
+        _description directories expl 'old path'
+      fi
+  
+      _files "$expl[@]" -/ && ret=0
+      ;;
+    esac
+  
+    [[ ret -eq 0 || $nm -ne $compstate[nmatches] ]] && return 0
+  done
+  
+  return ret
+}
 
-    _arguments -s \
-      "${commonopts[@]}" "${pathopts[@]}" \
-      --{short-circuit,clean,rmsource,sign,test} \
-      '--target:specify a build target:->target'\
-      '--buildroot:build root directory:_files -/' \
-      '--buildarch:architecture for which to build:->target' \
-      '--buildos:ositecture for which to build:' \
-      '--timecheck:time check (seconds):' "$tmp[1]" && ret=0
-    ;;
-  sigcheck)
-    _arguments -s \
-      '(-K)--checksig' '(--checksig)-K' \
-      "${commonopts[@]}" \
-      --no{pgp,md5} \
-      '*:RPM package file:->package_file' && ret=0
-    ;;
-  rebuild)
-    _arguments -s \
-      "${commonopts[@]}" "${pathopts[@]}" \
-      '*:RPM source package file:->package_file' && ret=0
-    ;;
-  target)
-    _wanted target expl 'Target platforms' \
-        compadd $(_call target rpm --showrc 2> /dev/null |grep 'compatible archs'|sed 's/.*: //') && ret=0
-    ;;
-  package_or_file)
-    state=package_file
-    ;&
-  package)
-    _wanted packages expl 'RPM package' \
-        compadd -M 'r:|-=* r:|=*' - $(_call packages rpm -qa 2> /dev/null) && ret=0
-    ;;
-  spec_file)
-    _wanted specfiles expl 'spec file' \
-        _files -g \*.spec && ret=0
-    ;;
-  package_file)
-    _wanted files expl 'RPM package file' \
-        _files -g '*.(#i)rpm' && ret=0
-    if [[ -prefix 1 (f|ht)tp:// ]]; then
-      _wanted urls expl 'URL of RPM package file' \
-          _urls -f -g '*.(#i)rpm' "${expl[@]}" && ret=0
-    else
-      _wanted urls expl 'URL of RPM package file' \
-          compadd -S '' "${expl[@]}" ftp:// http:// && ret=0
-    fi
-    ;;
-  package_src)
-    _files -g \*.src\(\#i\).rpm
-   ;&
-  tags)
-    if compset -P '*%*\{'; then
-      _wanted tags expl 'RPM tag' \
-          compadd -M 'm:{a-z}={A-Z}' -S '\}' - \
-                  "${(@)${(@f)$(_call tags rpm --querytags 2> /dev/null)}#RPMTAG_}" && ret=0
-    else
-      _message 'RPM format'
-    fi
-    ;;
-  capability)
-    _message 'RPM capability'
-    ;;
-  relocate)
-    if compset -P '*='; then
-      _description directories expl 'new path'
-    else
-      _description directories expl 'old path'
-    fi
+# set a sensible default caching policy
+local update_policy
+zstyle -s ":completion:*:*:rpm:*" cache-policy update_policy
+if [[ -z "$update_policy" ]]; then
+  zstyle ":completion:*:*:rpm:*" cache-policy _rpms_caching_policy
+fi
 
-    _files "$expl[@]" -/ && ret=0
-    ;;
-  esac
+_rpms_caching_policy () {
+  # rebuild if cache is more than a week old
+  oldp=( "$1"(Nmw+1) )
+  (( $#oldp )) && return 0
 
-  [[ ret -eq 0 || $nm -ne $compstate[nmatches] ]] && return 0
-done
+  [[ /var/lib/rpm/packages.rpm -nt "$1" ]]
+}
 
-return ret
+_rpm "$@"
diff --git a/Completion/User/_perl_modules b/Completion/User/_perl_modules
index 88efdd395..117933022 100644
--- a/Completion/User/_perl_modules
+++ b/Completion/User/_perl_modules
@@ -17,49 +17,85 @@
 #   algorithm (the zsh code does almost the same, but only misses
 #   modules which don't begin with an uppercase letter).
 
-local opts
-zparseopts -D -a opts S: q
-
-if [[ ${+_perl_modules} -eq 0 ]]; then
-  if zstyle -t ":completion:${curcontext}:modules" try-to-use-pminst \
-     && (( ${+commands[pminst]} )); then
-    _perl_modules=( $(pminst) )
-  else
-    local inc libdir new_pms
-    if (( ${+commands[perl]} )); then
-      inc=( $( perl -e 'print "@INC"' ) )
+_perl_modules () {
+  local opts
+  zparseopts -D -a opts S: q
+  
+  # Set a sensible default caching policy.  This has to be done inside
+  # this function otherwise we wouldn't know the context for the style.
+  local update_policy
+  zstyle -s ":completion:${curcontext}:" cache-policy update_policy
+  if [[ -z "$update_policy" ]]; then
+    zstyle ":completion:${curcontext}:" cache-policy \
+      _perl_modules_caching_policy
+  fi
+  
+  if ( [[ ${+_perl_modules} -eq 0 ]] || _cache_invalid perl_modules ) &&
+     ! _retrieve_cache perl_modules;
+  then
+    if zstyle -t ":completion:${curcontext}:modules" try-to-use-pminst &&
+       (( ${+commands[pminst]} ));
+    then
+      _perl_modules=( $(pminst) )
     else
-      # If perl isn't there, one wonders why the user's trying to
-      # complete Perl modules.  Maybe her $path is wrong?
-      _message "Didn't find perl on \$PATH; guessing @INC ..."
-
-      setopt localoptions extendedglob
-      inc=( /usr/lib/perl5{,/{site_perl/,}<5->.([0-9]##)}(N) 
-            ${(s.:.)PERL5LIB} )
+      local inc libdir new_pms
+      if (( ${+commands[perl]} )); then
+        inc=( $( perl -e 'print "@INC"' ) )
+      else
+        # If perl isn't there, one wonders why the user's trying to
+        # complete Perl modules.  Maybe her $path is wrong?
+        _message "Didn't find perl on \$PATH; guessing @INC ..."
+  
+        setopt localoptions extendedglob
+        inc=( /usr/lib/perl5{,/{site_perl/,}<5->.([0-9]##)}(N) 
+              ${(s.:.)PERL5LIB} )
+      fi
+  
+      typeset -agU _perl_modules  # _perl_modules is global, no duplicates
+      _perl_modules=( )
+  
+      for libdir in $inc; do
+        # Ignore cwd - could be too expensive e.g. if we're near /
+        if [[ $libdir == '.' ]]; then break; fi
+  
+        # Find all modules
+        if [[ -d $libdir && -x $libdir ]]; then
+        cd $libdir
+        new_pms=( {[A-Z]*/***/,}*.pm~*blib*(N) )
+        cd $OLDPWD
+        fi
+  
+        # Convert to Perl nomenclature
+        new_pms=( ${new_pms:r:fs#/#::#} )
+  
+        _perl_modules=( $new_pms $_perl_modules )
+      done
     fi
+  
+    _store_cache perl_modules _perl_modules
+  fi
+  
+  local expl
+  
+  _wanted modules expl 'Perl modules' compadd "$opts[@]" -a _perl_modules
+}
 
-    typeset -agU _perl_modules  # _perl_modules is global, no duplicates
-    _perl_modules=( )
-
-    for libdir in $inc; do
-      # Ignore cwd - could be too expensive e.g. if we're near /
-      if [[ $libdir == '.' ]]; then break; fi
+_perl_modules_caching_policy () {
+  local _perllocals
 
-      # Find all modules
-      if [[ -d $libdir && -x $libdir ]]; then
-      cd $libdir
-      new_pms=( {[A-Z]*/***/,}*.pm~*blib*(N) )
-      cd $OLDPWD
-      fi
+  # rebuild if cache is more than a week old
+  oldp=( "$1"(Nmw+1) )
+  (( $#oldp )) && return 0
 
-      # Convert to Perl nomenclature
-      new_pms=( ${new_pms:r:fs#/#::#} )
+  _perllocals=( /usr/lib/perl5/**/perllocal.pod(N) )
 
-      _perl_modules=( $new_pms $_perl_modules )
+  if (( $#_perllocals )); then
+    for pod in $_perllocals; do
+      [[ "$pod" -nt "$1" ]] && return 0
     done
   fi
-fi
 
-local expl
+  return 1
+}
 
-_wanted modules expl 'Perl modules' compadd "$opts[@]" -a _perl_modules
+_perl_modules "$@"