Add needed files

1 files changed, 369 insertions, 0 deletions

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 <<EOT;
+Usage:   pmdesc3 [-h] [-s] [-t ddd] [-v dd] [--] [dir [dir [dir [...]]]]
+Options:  -h         print this message
+          -s         sort output (not under Windows)
+          -t ddd     name column has width ddd (1-3 digits); default 36
+          -v  dd     version column has width ddd (1-3 digits); default 10
+          If no directories given, searches:
+$searchdirs
+EOT
+  exit;
+}
+
+#===  FUNCTION  ====================================================================
+#         NAME:  get_module_name
+#===================================================================================
+sub get_module_name {
+  my ($path, $relative_to) = @_;
+
+  local $_ = $path;
+  s!\A\Q$relative_to\E/?!!;
+  s! \.p(?:m|od) \z!!x;
+  s!/!::!g;
+
+  return $_;
+}
+
+#===  FUNCTION  ====================================================================
+#         NAME:  get_module_description
+#===================================================================================
+sub get_module_description 
+{
+  my  $desc;
+  my  ($INFILE_file_name) = @_;               # input file name
+
+  undef $/;                                   # undefine input record separator
+
+  open ( INFILE, '<', $INFILE_file_name )
+    or die "$0 : failed to open input file $INFILE_file_name : $!\n";
+
+  my  $file = <INFILE>;                       # 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 (<ME>) {
+      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"      : " <description not available>";
+
+					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"      : " <description not available>";
+
+					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)   <description not available>
+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
+