markers MUST start at col 1. if (m'^=([[:alpha:]]\w*)') { if ($1 eq 'cut') { $insidepod = 0; next; } $insidepod = 1; } next if $insidepod; # Once we reach __END__ or __DATA__, we're done. # Note: whitespace may precede and follow these markers (and any tokens may follow) m'^\s*__(END|DATA)__(\s|$)' and last; # NOTE: Currently, we don't deal with potential false positives from here-documents. # Getting here means: the line at hand potentially contains a package declaration. # Note that the package name, while rare in practice, may be followed by a version number # and/or code block, so we do NOT look for a terminating ';' # If we find a package ...; statement at the beginning of a line, extract the name. if (m'^\s*package\s+([\w:\']+)') { # note: Perl < 5 code used ' instead of :: to separate namespace components push @names, $1; last unless $all; } elsif (m'^\s*package\s*#?') { # possibly a 2-line obfuscated declaration to hide it from PAUSE $_ = <$fh>; # read next line if (m'^\s*([\w:\']+)') { push @names, $1; last unless $all; } } } close $fh; return $all ? @names : $names[0]; } # SYNOPSIS # unique LIST # DESCRIPTION # Returns a list with all duplicates removed from the input list. # Unlike with the Unix uniq utility, the input list need NOT be sorted. # CAVEATS # An item containing undef triggers a warning. # A null string is treated the same as undef, and whichever of # the two values encountered first is used in the return value. sub unique { my %seen; return grep { ! $seen{$_}++ } @_; } # SYNOPSIS # openurl # DESCRIPTION # Opens the specified URL in the system's default browser. # COMPATIBILITY # OSX, Windows (including MSYS, Git Bash, and Cygwin), Freedesktop-compliant # OSs, which includes many Linux distros (e.g., Ubuntu), PC-BSD, OpenSolaris... # CYGWIN CAVEAT: if a URL contains something that looks like a shell # variable reference to an *existing* variable (e.g., %PATH%), the # value is inadvertently expanded; fortunately, that should rarely # happen in the real world. # NOTES # To bypass variations in ad-hoc encoding across platforms, it is safer to # pass an already HTML-encoded URL (where, e.g., spaces are already encoded as '%20'). # Gratefully adapted from http://stackoverflow.com/a/8869676/45375. sub openurl { my $url = shift; my $platform = $^O; my $cmd; if ($platform eq 'darwin') { $cmd = "open \"$url\""; } # OS X elsif ($platform eq 'MSWin32' or $platform eq 'msys') { $cmd = "start \"\" \"$url\""; } # Windows native or Windows MSYS / Git Bash # !! Cygwin: Bizarrely, the only way to get cmd.exe to treat the URL as a # !! literal (almost), is to *append a space*, which, fortunately, is ultimately # !! ignored by browsers. The only edge case where interpretation still happens # !! is if the URL contains syntactically valid reference to an *existing* # !! environment variable; e.g., %PATH%. # !! The following test URL demonstrates that all other special chars. # !! are handled correctly: # !! http://example.org/test?foo^hat%20after%PATH1%&more=stuff(42<46)|@notsofast! elsif ($platform eq 'cygwin') { $cmd = "cmd.exe /c start \"\" \"$url \""; } # Cygwin; !! note the required trailing space else { $cmd = "xdg-open \"$url\""; } # assume a Freedesktop-compliant OS, which includes many Linux distros, PC-BSD, OpenSolaris, ... if (system($cmd) != 0) { die "Cannot locate or failed to open default browser; please go to '$url' manually.\n"; } } # SYNOPSIS # globex PATTERNLIST[, \%options] # DESCRIPTION # Extends the standard glob() function with support for recursive globbing. # Prepend '**/' to the part of the pattern that should match anywhere in the # subtree or end the pattern with '**' to match all files and dirs. in the # subtree, similar to Bash's `globstar` option. # # A pattern that doesn't contain '**' is passed to the regular glob() # function. # While you can use brace expressions such as {a,b}, using '**' INSIDE # such an expression is NOT supported, and will be treated as just '*'. # Unlike with glob(), whitespace in a pattern is considered part of that # pattern; use separate pattern arguments or a brace expression to specify # multiple patterns. # # To also follow directory symlinks, set 'follow' to 1 in the options hash # passed as the optional last argument. # Note that this changes the sort order - see below. # # Traversal: # For recursive patterns, any given directory examined will have its matches # listed first, before descending depth-first into the subdirectories. # # Hidden directories: # These are skipped by default, onless you set 'hiddendirs' to 1 in the # options hash passed as the optional last argument. # # Sorting: # A given directory's matching items will always be sorted # case-insensitively, as with glob(), but sorting across directories # is only ensured, if the option to follow symlinks is NOT specified. # # Duplicates: # Following symlinks only prevents cycles, so if a symlink and its target # they will both be reported. # (Under the hood, following symlinks activates the following # File::Find:find() options: `follow_fast`, with `follow_skip` set to 2.) # # Since the default glob() function is at the heart of this function, its # rules - and quirks - apply here too: # - If literal components of your patterns contain pattern metacharacters, # - * ? { } [ ] - you must make sure that they're \-escaped to be treated # as literals; here's an expression that works on both Unix and Windows # systems: s/[][{}\-~*?]/\\$&/gr # - Unlike with glob(), however, whitespace in a pattern is considered part # of the pattern; to specify multiple patterns, use either a brace # expression (e.g., '{*.txt,*.md}'), or pass each pattern as a separate # argument. # - A pattern ending in '/' restricts matches to directories and symlinks # to directories, but, strangely, also includes symlinks to *files*. # - Hidden files and directories are NOT matched by default; use a separate # pattern starting with '.' to include them; e.g., globex '**/{.*,*}' # matches all files and directories, including hidden ones, in the # current dir.'s subtree. # Note: As with glob(), .* also matches '.' and '..' # - Tilde expansion is supported; escape as '\~' to treat a tilde as the # first char. as a literal. # - A literal path (with no pattern chars. at all) is echoed as-is, # even if it doesn't refer to an existing filesystem item. # # COMPATIBILITY NOTES # Requires Perl v5.6.0+ # '/' must be used as the path separator on all platforms, even on Windows. # # EXAMPLES # # Find all *.txt files in the subtree of a dir stored in $mydir, including # # in hidden subdirs. # globex "$mydir/*.txt", { hiddendirs => 1 }; # # # Find all *.txt and *.bak files in the current subtree. # globex '**/*.txt', '**/*.bak'; # # # Ditto, though with different output ordering: # # Unlike above, where you get all *.txt files across all subdirs. first, # # then all *.bak files, here you'll get *.txt files, then *.bak files # # per subdirectory encountered. # globex '**/{*.txt,*.bak}'; # # # Find all *.pm files anywhere in the subtrees of the directories in the # # module search path, @INC; follow symlinks. # # Note: The assumption is that no directory in @INC has embedded spaces # # or contains pattern metacharacters. # globex '{' . (join ',', @INC) . '}/**/*.pm', { follow => 1 }; sub globex { use File::Find; use File::Spec; use File::Basename; use File::Glob qw/bsd_glob GLOB_BRACE GLOB_NOMAGIC GLOB_QUOTE GLOB_TILDE GLOB_ALPHASORT/; my @patterns = @_; # Set the flags to use with bsd_glob() to emulate default glob() behavior. my $globflags = GLOB_BRACE | GLOB_NOMAGIC | GLOB_QUOTE | GLOB_TILDE | GLOB_ALPHASORT; my $followsymlinks; my $includehiddendirs; if (ref($patterns[-1]) eq 'HASH') { my $opthash = pop @patterns; $followsymlinks = $opthash->{follow}; $includehiddendirs = $opthash->{hiddendirs}; } unless (@patterns) { return }; my @matches; my $ensuredot; my $removedot; # Use fc(), the casefolding function for case-insensitive comparison, if available. my $cmpfunc = defined &CORE::fc ? \&CORE::fc : \&CORE::lc; for (@patterns) { my ($startdir, $anywhereglob) = split '(?:^|/)\*\*(?:/|$)'; if (defined $anywhereglob) { # recursive glob if ($startdir) { $ensuredot = 1 if m'\./'; # if pattern starts with '.', ensure it is prepended to all results } elsif (m'^/') { # pattern starts with root dir, '/' $startdir = '/'; } else { # pattern starts with '**'; must start recursion with '.', but remove it from results $removedot = 1; $startdir = '.'; } unless ($anywhereglob) { $anywhereglob = '*'; } my $terminator = m'/$' ? '/' : ''; # Apply glob() to the start dir. as well, as it may be a pattern itself. my @startdirs = bsd_glob $startdir, $globflags or next; find({ wanted => sub { # Ignore symlinks, unless told otherwise. unless ($followsymlinks) { -l $File::Find::name and return; } # Ignore non-directories and '..'; we only operate on # subdirectories, where we do our own globbing. ($_ ne '..' and -d) or return; # Skip hidden dirs., unless told otherwise. unless ($includehiddendirs) { return if basename($_) =~ m'^\..'; } my $globraw; # Glob without './', if it wasn't part of the input pattern. if ($removedot and m'^\./(.+)$') { $_ = $1; } $globraw = File::Spec->catfile($_, $anywhereglob); # Ensure a './' prefix, if the input pattern had it. # Note that File::Spec->catfile() removes it. if($ensuredot) { $globraw = './' . $globraw if $globraw !~ m'\./'; } push @matches, bsd_glob $globraw . $terminator, $globflags; }, no_chdir => 1, follow_fast => $followsymlinks, follow_skip => 2, # Pre-sort the items case-insensitively so that subdirs. are processed in sort order. # NOTE: Unfortunately, the preprocess sub is only called if follow_fast (or follow) are FALSE. preprocess => sub { return sort { &$cmpfunc($a) cmp &$cmpfunc($b) } @_; } }, @startdirs); } else { # simple glob push @matches, bsd_glob($_, $globflags); } } return @matches; } #### # MAN PAGE MARKDOWN SOURCE # - Place a Markdown-formatted version of the man page for this script # below the `__DATA__` line below. # - Do not alter the `__DATA__` line in any way. # - The entire rest of this script # is assumed to be the Markdown document. # - The document must be formatted to look good in all 3 viewing scenarios: # - as a man page, after conversion to ROFF with marked-man # - as plain text (raw Markdown source) # - as HTML (rendered Markdown) # Markdown formatting guidelines: # - GENERAL # To support plain-text rendering in the terminal, limit all lines to 80 chars., # and, for similar rendering as HTML, *end every line with 2 trailing spaces*. # - HEADINGS # - For better plain-text rendering, leave an empty line after a heading # marked-man will remove it from the ROFF version. # - The first heading must be a level-1 heading containing the utility # name and very brief description; append the manual-section number # directly to the CLI name; e.g.: # # foo(1) - does bar # - The 2nd, level-2 heading must be '## SYNOPSIS' and the chapter's body # must render reasonably as plain text, because it is printed to stdout # when `-h`, `--help` is specified: # Use 4-space indentation without markup for both the syntax line and the # block of brief option descriptions; represent option-arguments and operands # in angle brackets; e.g., '' # - All other headings should be level-2 headings in ALL-CAPS. # - TEXT # - Use NO indentation for regular chapter text; if you do, it will # be indented further than list items. # - Use 4-space indentation, as usual, for code blocks. # - Markup character-styling markup translates to ROFF rendering as follows: # `...` and **...** render as bolded (red) text # _..._ and *...* render as word-individually underlined text # - LISTS # - Indent list items by 2 spaces for better plain-text viewing, but note # that the ROFF generated by marked-man still renders them unindented. # - End every list item (bullet point) itself with 2 trailing spaces too so # that it renders on its own line. # - Avoid associating more than 1 paragraph with a list item, if possible, # because it requires the following trick, which hampers plain-text readability: # Use ' ' in lieu of an empty line. #### __DATA__ # whichpm(1) - locate installed Perl modules ## SYNOPSIS Prints the filesystem paths of the specified Perl modules, if installed. whichpm [-v] [-q] [-e] ... whichpm -a [-v] [-q] [-e] [...] -a ... lists all installed module files / all module files matching the specified name(s) (checks for accidental duplicates) -v ... verbose mode: also prints name, version, core-module status -q ... suppresses warnings -e ... opens modules in default text editor Standard options: `--help`, `--man`, `--version`, `--home` ## DESCRIPTION `whichpm` reports the filesystem path of Perl modules by module (package) name, similar to what the Unix `which` utility does for binaries. Optionally, additional information can be output, and all installed modules can be listed. The exit code reflects the number of modules that could NOT be found. I.e., a non-zero exit code implies that at least one module could not be found. Conversely, exit code 0 implies that all specified modules were located successfully. Note that using `-v` requires starting a separate Perl instance for each module examined in order to determine the version number. A separate Perl instance is the only safe way to load a module without affecting operation of this utility itself. Combining `-v` with `-a` with no module names therefore results in a lengthy, resource-intensive operation. ## OPTIONS * `-a, --all`, if no module names are specified, prints the filesystem paths of all installed modules. See caveat re combining with `-v` above. Otherwise, prints the paths of all files matching the specified module name(s), which effectively tells you whether a given module is accidentally installed in more than one location. * `-e, --edit` also opens the module files in your system's default text editor. On Windows, you may be prompted to choose that editor on first run. Caveat: Will not work on Cygwin. * `-v, --verbose` also outputs the package name, version number, and information about whether the module is a core module; see performance caveat above. Output format: `\t\t\t` On Unix platforms, pipe to `column -t` for column-aligned display. If the package name or version number cannot be determined, `?` is printed. `` shows the following: * If the module is a core module: Something like `core>=5.005`, which indicates what Perl version first included the module. To see a list of what Perl version included what version of the module, run `corelist -a `. * Otherwise: `(non-core)` If your Perl version is too old to support this check, or if the module name couldn't be determined (when using `-a -v` without operands), you'll see `(n/a)`. * `-q, --quiet` suppresses warnings, such as when a module file's package name cannot be determined, duplicate module files are found, or, on Windows or OSX, when a case-inexact form of a module name is specified. ## STANDARD OPTIONS All standard options provide information only. * `-h, --help` Prints the contents of the synopsis chapter to stdout for quick reference. * `--man` Displays this manual page, which is a helpful alternative to using `man` if the manual page is not installed, such as on Windows. * `--version` Prints version information. * `--home` Opens this utility's home page in the system's default web browser. ## NOTES On platforms with case-sensitive filesystems you must specify case-exact package names, as Perl itself requires; for instance, 'data::dumper' will not find the 'Data::Dumper' module. On case-insensitive filesystems, such as on Windows and OS X, you can get away with specifying a case-inexact package name, but a warning will be issued. Note that Perl's search path for modules (`@INC`) typically includes the current directory (`.`), so you may get different results depending on which directory `whichpm` is called from. When using `-a` without module names in combination with `-v`, the package names have to be extracted by custom-parsing the module file, which may not succeed in all cases - package declarations may be missed, or false positives may be found. ## COMPATIBILITY Requires Perl v5.4.50 or higher; for core-module status information, v5.8.9 or higher is required. Expected to work on Unix-like platforms and Windows. ## EXAMPLES # Find and report additional information about the Data::Dumper module, # then open it in the default text editor. whichpm -v -e Data::Dumper ## LICENSE Copyright (c) 2015 Michael Klement (mklement0@gmail.com), released under the [MIT license](https://spdx.org/licenses/MIT)