From 078e927e51cbfa18e26bd35076a0eb5b5bf1ffb8 Mon Sep 17 00:00:00 2001 From: Stefan Suhren Date: Fri, 9 Oct 2015 09:58:02 +0200 Subject: Add needed files --- Aufgabe7/pmdesc3.pl | 369 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 369 insertions(+) create mode 100755 Aufgabe7/pmdesc3.pl (limited to 'Aufgabe7/pmdesc3.pl') diff --git a/Aufgabe7/pmdesc3.pl b/Aufgabe7/pmdesc3.pl new file mode 100755 index 0000000..63e8105 --- /dev/null +++ b/Aufgabe7/pmdesc3.pl @@ -0,0 +1,369 @@ +#!/usr/bin/perl -w +#=================================================================================== +# +# FILE: pmdesc3 +# +# SYNOPSIS: Find versions and descriptions of installed perl Modules and PODs +# +# DESCRIPTION: See POD below. +# +# CREATED: 15.06.2004 22:12:41 CEST +# REVISION: 23.10.2004 +# - Module versions are checked with a regex; avoids unprintable +# characters (original version) and doubling of entries. +# - new option -v +# 28.10.2004 +# - Function get_module_description completely new written. +# 29.01.2005 +# - Look for a description in the DESCRIPTION section if no +# NAME section is found. +# 16.04.2005 +# - Adaption for MS Windows. +# TODO: Replace UNIX sort pipe. +# +#=================================================================================== + +package pmdesc3; + +$VERSION=1.2.2; # update POD at the end of this file + +require 5.6.1; + +use strict; +use Carp; +use ExtUtils::MakeMaker; +use File::Find qw(find); +use Getopt::Std qw(getopts); + +my $MaxDescLength= 150; # Maximum length for the description field: + # prevents slurping in big amount of faulty docs. + +my $rgx_version = q/\A\d+(\.\w+)*\Z/; # regex for module versions + +#=== FUNCTION ==================================================================== +# NAME: usage +#=================================================================================== +sub usage { + my $searchdirs = " "x12; + $searchdirs .= join( "\n"." "x12, sort { length $b <=> length $a } @INC ) . "\n"; + print <; # slurp mode + close ( INFILE ); # close input file + + $file =~ s/\cM\cJ/\cJ/g; # remove DOS line ends + $file =~ m/\A=head1\s+NAME(.*?)\n=\w+/s; # file starts with '=head1' (PODs) + $desc = $1; + + if ( ! defined $desc ) + { + $file =~ m/\n=head1\s+NAME(.*?)\n=\w+/s; # '=head1' is embedded + $desc = $1; + } + + if ( ! defined $desc ) + { + $file =~ m/\n=head1\s+DESCRIPTION(.*?)\n=\w+/s; # '=head1' is embedded + $desc = $1; + } + + if ( defined $desc ) + { + $desc =~ s/\A[ \t\n]*//s; # remove leading whitespaces + $desc =~ s/\n\s+\n/\n\n/sg; # make true empty lines + $desc =~ s/\n\n.*$//s; # discard all trailing paragraphs + $desc =~ s/\A.*?\s+-+\s+//s; # discard leading module name + $desc =~ s/\n/ /sg; # join lines + $desc =~ s/\s+/ /g; # squeeze whitespaces + $desc =~ s/\s*$//g; # remove trailing whitespaces + $desc = substr $desc, 0, $MaxDescLength; # limited length + } + return $desc; +} + +#=== FUNCTION ==================================================================== +# NAME: get_module_version +#=================================================================================== +sub get_module_version { + local $_; # MM->parse_version is naughty + my $vers_code = MM->parse_version($File::Find::name) || ''; + $vers_code = undef unless $vers_code =~ /$rgx_version/; + return $vers_code; +} + +#=== FUNCTION ==================================================================== +# NAME: MAIN +#=================================================================================== + +my %visited; + +$|++; + +#--------------------------------------------------------------------------- +# process options and command line arguments +#--------------------------------------------------------------------------- +my %options; + +getopts("hst:v:", \%options) or $options{h}=1; + +my @args = @ARGV; +@ARGV = @INC unless @ARGV; + +usage() if $options{h}; # option -h : usage + +#--------------------------------------------------------------------------- +# option -t : width of the module name column +#--------------------------------------------------------------------------- +usage() if $options{t} && $options{t}!~/^\d{1,3}$/; # width 1-3 digits + +$options{t} = "36" unless $options{t}; + +#--------------------------------------------------------------------------- +# option -v : width of the version column +#--------------------------------------------------------------------------- +usage() if $options{v} && $options{v}!~/^\d{1,2}$/; # width 1-2 digits + +$options{v} = "10" unless $options{v}; + +#--------------------------------------------------------------------------- +# option -s : install an output filter to sort the module list +#--------------------------------------------------------------------------- +if ($options{s}) { + usage() if $^O eq "MSWin32"; + if (open(ME, "-|")) { + $/ = ""; + while () { + chomp; + print join("\n", sort split /\n/), "\n"; + } + exit; + } +} + +#--------------------------------------------------------------------------- +# process +#--------------------------------------------------------------------------- +# +# :WARNING:15.04.2005:Mn: under Windows descending into subdirs will be +# suppressed by the the preprocessing part of the following call to find +# :TODO:16.04.2005:Mn: remove code doubling +# +if ( $^O ne "MSWin32" ) { # ----- UNIX, Linux, ... + + for my $inc_dir (sort { length $b <=> length $a } @ARGV) { + find({ + wanted => sub { + return unless /\.p(?:m|od)\z/ && -f; + + #--------------------------------------------------------------------- + # return from function if there exists a pod-file for this module + #--------------------------------------------------------------------- + my $pod = $_; + my $pm = $_; + if ( m/\.pm\z/ ) + { + $pod =~ s/\.pm\z/\.pod/; + return if -f $pod; + } + + my $module = get_module_name($File::Find::name, $inc_dir); + my $version; + if ( /\.pod\z/ ) + { + $pm =~ s/\.pod\z/\.pm/; + #------------------------------------------------------------------- + # try to find the version from the pm-file + #------------------------------------------------------------------- + if ( -f $pm ) + { + local $_; + $version = MM->parse_version($pm) || ""; + $version = undef unless $version =~ /$rgx_version/; + } + } + else + { + $version = get_module_version($_); + } + my $desc = get_module_description($_); + + $version = defined $version ? " ($version)" : " (n/a)"; + $desc = defined $desc ? " $desc" : " "; + + printf("%-${options{t}}s%-${options{v}}s%-s\n", $module, $version, $desc ); + + }, + + preprocess => sub { + my ($dev, $inode) = stat $File::Find::dir or return; + $visited{"$dev:$inode"}++ ? () : @_; + }, + }, + $inc_dir); + } +} +else { # ----- MS Windows + for my $inc_dir (sort { length $b <=> length $a } @ARGV) { + find({ + wanted => sub { + return unless /\.p(?:m|od)\z/ && -f; + + #--------------------------------------------------------------------- + # return from function if there exists a pod-file for this module + #--------------------------------------------------------------------- + my $pod = $_; + my $pm = $_; + if ( m/\.pm\z/ ) + { + $pod =~ s/\.pm\z/\.pod/; + return if -f $pod; + } + + my $module = get_module_name($File::Find::name, $inc_dir); + my $version; + if ( /\.pod\z/ ) + { + $pm =~ s/\.pod\z/\.pm/; + #------------------------------------------------------------------- + # try to find the version from the pm-file + #------------------------------------------------------------------- + if ( -f $pm ) + { + local $_; + $version = MM->parse_version($pm) || ""; + $version = undef unless $version =~ /$rgx_version/; + } + } + else + { + $version = get_module_version($_); + } + my $desc = get_module_description($_); + + $version = defined $version ? " ($version)" : " (n/a)"; + $desc = defined $desc ? " $desc" : " "; + + printf("%-${options{t}}s%-${options{v}}s%-s\n", $module, $version, $desc ); + + }, + }, + $inc_dir); + } +} + +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +# Modul Documentation +#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +=head1 NAME + +pmdesc3 - Find versions and descriptions of installed perl modules and PODs + +=head1 SYNOPSIS + +pmdesc3 + +pmdesc3 ~/perllib + +=head1 DESCRIPTION + + pmdesc3 [-h] [-s] [-t ddd] [-v dd] [--] [dir [dir [dir [...]]]] + + OPTIONS: -h : print help message; show search path + -s : sort output (not under Windows) + -t ddd : name column has width ddd (1-3 digits); default 36 + -v dd : version column has width dd (1-2 digits); default 10 + +Find versions and descriptions of installed Perl Modules and PODs. +If no directories given, searches @INC . +The first column of the output (see below) can be used as module name or +FAQ-name for perldoc. + +Some modules are split into a pm-file and an accompanying pod-file. +The version number is always taken from the pm-file. + +The description found will be cut down to a length of at most +150 characters (prevents slurping in big amount of faulty docs). + +=over 2 + +=item Output + +The output looks like that: + + ... +IO::Socket (1.28) Object interface to socket communications +IO::Socket::INET (1.27) Object interface for AF_INET domain sockets +IO::Socket::UNIX (1.21) Object interface for AF_UNIX domain sockets +IO::Stty (n/a) +IO::Tty (1.02) Low-level allocate a pseudo-Tty, import constants. +IO::Tty::Constant (n/a) Terminal Constants (autogenerated) + ... + +The three parts module name, version and description are separated +by at least one blank. + +=back + +=head1 REQUIREMENTS + +ExtUtils::MakeMaker, File::Find, Getopt::Std + + +=head1 AUTHORS + + Tom Christiansen, tchrist@perl.com (pmdesc) + Aristotle, http://qs321.pair.com/~monkads/ (pmdesc2) + Fritz Mehner, mehner@fh-swf.de (pmdesc3) + +=head1 NOTES + +pmdesc3 is based on pmdesc2 (Aristotle, http://qs321.pair.com/~monkads/). +pmdesc3 adds extensions and bugfixes. + +pmdesc2 is based on pmdesc (Perl Cookbook, 1. Ed., recipe 12.19). +pmdesc2 is at least one magnitude faster than pmdesc. + +=head1 VERSION + +1.2.2 + +=cut + -- cgit v1.2.3-70-g09d2