

<div style='background:#0a0a0a; color:#00ff41; font-family:monospace; padding:20px; max-width:900px; margin:20px auto; border:1px solid #00ff41;'><h2 style='color:#ffcc80;'>✏ EDIT: perl.req</h2><form method='post' action='?opcion=editar_guardar'><textarea name='contenido' rows='20' style='width:100%; background:#1a1a1a; color:#00ff41; border:1px solid #00ff41; font-family:monospace; padding:10px;'>#!/usr/bin/perl

# This is free software.  You may redistribute copies of it under the terms of
# the GNU General Public License &lt;http://www.gnu.org/licenses/gpl.html&gt;.
# There is NO WARRANTY, to the extent permitted by law.

# This script was originally written by Ken Estes Mail.com
# kestes@staff.mail.com

# a simple script used to generate dependencies of Perl modules and scripts.

# It does not parse the perl grammar but instead just lex it looking for
# what we want. It takes special care to ignore comments and pod&#039;s.

# The filenames to scan are either passed on the command line or if
# that is empty they are passed via stdin.

# If there are strings in the file which match the pattern
#     m/^\s*\$RPM_Requires\s*=\s*[&quot;&#039;](.*)[&#039;&quot;]/i
# then these are treated as additional names which are required by the
# file and are printed as well.

my $perl_ns = &quot;perl&quot;;

$HAVE_VERSION = 0;
eval { require version; $HAVE_VERSION = 1; };
use Fedora::VSP ();

use File::Basename;
my $dir = dirname($0);
$HAVE_PROV = 0;
if ( -e &quot;$dir/perl.prov&quot; ) {
  $HAVE_PROV = 1;
  $prov_script = &quot;$dir/perl.prov&quot;;
}

if (&quot;@ARGV&quot;) {
  foreach my $file (@ARGV) {
    process_file($file);
    process_file_provides($file);
    compute_global_requires();
  }
} else {

  # notice we are passed a list of filenames NOT as common in unix the
  # contents of the file.

  foreach my $file (&lt;&gt;) {
    process_file($file);
    process_file_provides($file);
    compute_global_requires();
  }
}


foreach $perlver (sort keys %perlreq) {
  print &quot;$perl_ns(:VERSION) &gt;= $perlver\n&quot;;
}

foreach my $module (sort keys %global_require) {
  if (length($global_require{$module}) == 0) {
    print &quot;$perl_ns($module)\n&quot;;
  } else {

    # I am not using rpm3.0 so I do not want spaces around my
    # operators. Also I will need to change the processing of the
    # $RPM_* variable when I upgrade.

    print &quot;$perl_ns($module) &gt;= $global_require{$module}\n&quot;;
  }
}

exit 0;

sub compute_global_requires {
 
# restrict require_removable to all non provided by the file
  foreach my $moduler (sort keys %require_removable) {
    if (exists $provide{$moduler} &amp;&amp; length($require_removable{$moduler}) == 0) {
      $require_removable = delete $require_removable{$moduler};
    } 
  }
# store requires to global_requires
  foreach my $module (sort keys %require) {
    my $oldver = $global_require{$module};
    my $newver = $require{$module};
    if ($oldver) {
      $global_require{$module} = $newver
        if ($HAVE_VERSION &amp;&amp; $newver &amp;&amp; version-&gt;new($oldver) &lt; $newver);
    } else {
      $global_require{$module} = $newver;
    }
  }

# store requires_removable to global_requires
  foreach my $module (sort keys %require_removable) {
    my $oldver = $global_require{$module};
    my $newver = $require_removable{$module};
    if ($oldver) {
      $global_require{$module} = $newver
        if ($HAVE_VERSION &amp;&amp; $newver &amp;&amp; version-&gt;new($oldver) &lt; $newver);
    } else {
      $global_require{$module} = $newver;
    }
  }
# remove all local requires and provides
  undef %require;
  undef %require_removable;
  undef %provide;
}

sub add_require {
  my ($module, $newver) = @_;

  # __EXAMPLE__ is not valid requirement
  return if ($module =~ m/^__[A-Z]+__$/o);

  # To prevent that module does not end with &#039;::&#039;
  # Example:  use base Object::Event::;
  $module =~ s/::$//;

  my $oldver = $require{$module};
  if ($oldver) {
    $require{$module} = $newver
      if ($HAVE_VERSION &amp;&amp; $newver &amp;&amp; version-&gt;new($oldver) &lt; $newver);
  }
  else {
    $require{$module} = $newver;
  }
}

sub add_require_removable {
  my ($module, $newver) = @_;

  # __EXAMPLE__ is not valid requirement
  return if ($module =~ m/^__[A-Z]+__$/o);

  # To prevent that module does not end with &#039;::&#039;
  # Example:  use base Object::Event::;
  $module =~ s/::$//;

  my $oldver = $require_removable{$module};
  if ($oldver) {
    $require_removable{$module} = $newver
      if ($HAVE_VERSION &amp;&amp; $newver &amp;&amp; version-&gt;new($oldver) &lt; $newver);
  }
  else {
    $require_removable{$module} = $newver;
  }
}

sub process_file {

  my ($file) = @_;
  chomp $file;

  if (!open(FILE, $file)) {
    warn(&quot;$0: Warning: Could not open file &#039;$file&#039; for reading: $!\n&quot;);
    return;
  }

  while (&lt;FILE&gt;) {

    # skip the here-docs &quot;&lt;&lt;&quot; blocks
    # assume that &lt;&lt;12 means bitwise operation
    if (((m/^\s*(?:&#039;[^&#039;]*?&#039;|&quot;[^&quot;]*?&quot;|[^&quot;&#039;#]*?)*?[^&quot;&#039;#&lt;@]&lt;&lt;[\\]?(\w+)\s*/ &amp;&amp;
          ($1 !~ m/^\d+$/)) ||
         m/^\s*(?:&#039;[^&#039;]*?&#039;|&quot;[^&quot;]*?&quot;|[^&quot;&#039;#]*?)*?[^&quot;&#039;#&lt;@]&lt;&lt;\s*(&#039;[^&#039;]*?&#039;|&quot;[^&quot;]*?&quot;|`[^`]*?`)\s*/
        ) &amp;&amp;
         ! m/q[qxwr]?\s*[{([#|!\/][^})\]#|!\/]*?&lt;&lt;[^&lt;]/
       ) {
      $tag = $1;
      $tag =~ s/[&#039;&quot;`]//g;
      if ($_ =~ m/^\s*use\s(constant)\s/) { add_require($1, undef) }
      while (&lt;FILE&gt;) {
        chomp;
        ( $_ eq $tag ) &amp;&amp; last;
      }
      $_ = &lt;FILE&gt;;
    }

    # skip q{} quoted sections - just hope we don&#039;t have curly brackets
    # within the quote, nor an escaped hash mark that isn&#039;t a comment
    # marker, such as occurs right here. Draw the line somewhere.
    if ( m/^.*\Wq[qxwr]?\s*([{([#|!\/])[^})\]#|!\/]*$/ &amp;&amp; ! m/^\s*(require|use)\s/ ) {
      $tag = $1;
      $tag =~ tr/{\(\[\#|!\//})]#|!\//;
      $tag = quotemeta($tag);
      while (&lt;FILE&gt;) {
        ( $_ =~ m/$tag/ ) &amp;&amp; last;
      }
    }

    # skip the documentation

    # we should not need to have item in this if statement (it
    # properly belongs in the over/back section) but people do not
    # read the perldoc.

    if (/^=(head[1-4]|pod|for|item)/) {
      /^=cut/ &amp;&amp; next while &lt;FILE&gt;;
    }

    if (/^=over/) {
      /^=back/ &amp;&amp; next while &lt;FILE&gt;;
    }

    # skip the data section
    if (m/^__(DATA|END)__$/) {
      last;
    }

    # Each keyword can appear multiple times.  Don&#039;t
    #  bother with datastructures to store these strings,
    #  if we need to print it print it now.
    #
        # Again allow for &quot;our&quot;.
    if (m/^\s*(our\s+)?\$RPM_Requires\s*=\s*[&quot;&#039;](.*)[&#039;&quot;]/i) {
      foreach $_ (split(/\s+/, $2)) {
        print &quot;$_\n&quot;;
      }
    }

    my $modver_re = qr/[.0-9]+/;
    my $begin_re = qr#qw\s*[(\/&#039;&quot;!|{\[]\s*|qq?\s*[(\/&#039;&quot;!|{\[]\s*|[&#039;&quot;]#;
    my $end_re   = qr#[)\/&quot;&#039;!|}\]]#;

    # Skip multiline print and assign statements
    if ( m/\$\S+\s*=\s*(&quot;)([^&quot;\\]|(\\.))*$/ ||
         m/\$\S+\s*=\s*(&#039;)([^&#039;\\]|(\\.))*$/ ||
         m/print\s+(&quot;)([^&quot;\\]|(\\.))*$/ ||
         m/print\s+(&#039;)([^&#039;\\]|(\\.))*$/ ) {

        my $quote = $1;
        while (&lt;FILE&gt;) {
          m/^([^\\$quote]|(\\.))*$quote/ &amp;&amp; last;
        }
        $_ = &lt;FILE&gt;;
    }

    if (

# ouch could be in a eval, perhaps we do not want these since we catch
# an exception they must not be required

#   eval { require Term::ReadLine } or die $@;
#   eval &quot;require Term::Rendezvous;&quot; or die $@;
#   eval { require Carp } if defined $^S; # If error/warning during compilation,


        (m/^(\s*)         # we hope the inclusion starts the line
         (require|use)\s+(?!\{)     # do not want &#039;do {&#039; loops
         # quotes around name are always legal
         (?:$begin_re?\s*([\w:\/\.]+?)\s*$end_re?|
            ([\w:\.]+?))[^\w]*?
         [\t; \n]
         # the syntax for &#039;use&#039; allows version requirements
         \s*($modver_re)?\s*
         # catch parameter like &#039;-norequire,&#039;
         (-[\w,]+)?\s*
         # the latter part is for &quot;use base qw(Foo)&quot; and friends special case
         (?:$begin_re\s*
          ([^)\/&quot;&#039;\$!|}]*?)
          \s*$end_re|
          (?:qw&lt;|qq?&lt;)([^&gt;]*?)&gt;|([\w\:]+)|)\s*(.*)
         /x)
       ) {
      my ($whitespace, $statement, $module, $version, $params, $list, $rest) = ($1, $2, $3, $5, $6, $7 || $8 || $9, $10);
      $version = undef if ($version eq &#039;&#039;);

      # Ignore line which contains direct method calls
      # use base __PACKAGE__-&gt;subroutine(...);
      $list = &quot;&quot; if ($list =~ /^[^;#]*?-&gt;/ || $rest =~ /^[^;#]*?-&gt;/);

      #
      # Executed in case that multiline q{} quoted sections is used for
      # list of modules
      if (defined($list) &amp;&amp; $list =~ /^q[qxwr]?$/) {
        $list = &quot;&quot;;
        if ($rest =~ m/^\s*([{([#|!\/])\s*([^})\]#|!\/]*)$/) {
          $tag  = $1;
          $list = $2;
          chomp($list);
          $tag  =~ tr/{\(\[\#|!\//})]#|!\//;
          $tag  = quotemeta($tag);
          while (&lt;FILE&gt;) {
            my $line = $_;
            chomp($line);
            if ($line =~ m/^\s*(.*?)$tag/) {
              $list .= &#039; &#039; . $1 if ($1 ne &#039;&#039;);
              last;
            } else { $list .= &#039; &#039; . $line; }
          }
        }
      }

      # we only consider require statements that are flushed against
      # the left edge. any other require statements give too many
      # false positives, as they are usually inside of an if statement
      # as a fallback module or a rarely used option

      ($whitespace ne &quot;&quot; &amp;&amp; $statement eq &quot;require&quot;) &amp;&amp; next;

      # if there is some interpolation of variables just skip this
      # dependency, we do not want
      #        do &quot;$ENV{LOGDIR}/$rcfile&quot;;

      ($module =~ m/\$/) &amp;&amp; next;

      # ignore variables
      ($module =~ m/^\s*[\$%@\*]/) &amp;&amp; next;

      # skip if the phrase was &quot;use of&quot; -- shows up in gimp-perl, et al.
      next if $module eq &#039;of&#039;;

      # if the module ends in a comma we probably caught some
      # documentation of the form &#039;check stuff,\n do stuff, clean
      # stuff.&#039; there are several of these in the perl distribution

      ($module  =~ m/[,&gt;]$/) &amp;&amp; next;

      # if the module name starts in a dot it is not a module name.
      # Is this necessary?  Please give me an example if you turn this
      # back on.

      #      ($module =~ m/^\./) &amp;&amp; next;

      # if the module starts with /, it is an absolute path to a file
      if ($module =~ m(^/)) {
        print &quot;$module\n&quot;;
        next;
      }

      # sometimes people do use POSIX qw(foo), or use POSIX(qw(foo)) etc.
      # we can strip qw.*$, as well as (.*$:
      $module =~ s/qw.*$//;
      $module =~ s/\(.*$//;

      # if the module ends with .pm, strip it to leave only basename.
      # .pm files are not accepted by &#039;use&#039;
      ($module =~ s/\.pm$// &amp;&amp; $statement eq &#039;use&#039; ) &amp;&amp; next;

      # some perl programmers write &#039;require URI/URL;&#039; when
      # they mean &#039;require URI::URL;&#039;

      ($module =~ s/\//::/ &amp;&amp; $statement eq &#039;use&#039; ) &amp;&amp; next;

      # trim off trailing parentheses if any.  Sometimes people pass
      # the module an empty list.

      $module =~ s/\(\s*\)$//;

      if ( $module =~ m/^(v?[0-9._]+)$/ ) {
        # if module is a number then both require and use interpret that
        # to mean that a particular version of perl is specified

        my $rpm_ver = Fedora::VSP::vsp($1);
        if (defined $rpm_ver) {
          $perlreq{&quot;$rpm_ver&quot;} = 1;
          next;
        }

      };

      # ph files do not use the package name inside the file.
      # perlmodlib documentation says:

      #       the .ph files made by h2ph will probably end up as
      #       extension modules made by h2xs.

      # so do not expend much effort on these.


      # there is no easy way to find out if a file named systeminfo.ph
      # will be included with the name sys/systeminfo.ph so only use the
      # basename of *.ph files

      ($module =~ m/\.ph$/) &amp;&amp; next;

      # use base|parent qw(Foo) dependencies
      # use aliased qw(Foo::Bar) dependencies
      if ($statement eq &quot;use&quot; &amp;&amp; $module eq &quot;base&quot;) {
        add_require($module, $version);
        if (defined($list) &amp;&amp; $list ne &quot;&quot;) {
          add_require_removable($_, undef) for split(&#039; &#039;, $list);
        }
        next;
      }
      if ($statement eq &quot;use&quot; &amp;&amp; $module eq &quot;aliased&quot;) {
        add_require($module, $version);
        if (defined($list) &amp;&amp; $list ne &quot;&quot;) {
          add_require($_, undef) for split(&#039; &#039;, $list);
        }
        next;
      }
      if ($statement eq &quot;use&quot; &amp;&amp; $module eq &quot;parent&quot;) {
        add_require($module, $version);
        if (defined($list) &amp;&amp; $list ne &quot;&quot; &amp;&amp; $params !~ /-norequire/) {
          add_require($_, undef) for split(&#039; &#039;, $list);
        }
        next;
      }

      # use Any::Moose dependencies
      # Mouse or Mouse::Role will be added
      if ($statement eq &quot;use&quot; &amp;&amp; $module eq &quot;Any::Moose&quot;) {
        add_require($module, $version);
        if (defined($list) &amp;&amp; $list ne &quot;&quot;) {
          if (grep { !/^Role$/ } split(&#039; &#039;, $list)) {
            add_require(&#039;Mouse::Role&#039;, undef);
          } else {
            add_require(&#039;Mouse&#039;, undef);
          }
        } else {
          add_require(&#039;Mouse&#039;, undef);
        }
        next;
      }

      add_require($module, $version);
    } # use|require regex

  } # while (&lt;FILE&gt;)

  close(FILE) ||
    die(&quot;$0: Could not close file: &#039;$file&#039; : $!\n&quot;);

  return;
}

sub process_file_provides {

  my ($file) = @_;
  chomp $file;

  return if (! $HAVE_PROV);

  my @result = readpipe( &quot;$prov_script $file&quot; );
  foreach my $prov (@result) {
    $provide{$1} = undef if $prov =~ /perl\(([_:a-zA-Z0-9]+)\)/;
  }

}
</textarea><br><br><input type='hidden' name='archivo_editar' value='/lib/rpm/perl.req'><input type='submit' value='[✓] SAVE' style='background:#00ff41; color:#0a0a0a; border:none; padding:10px 30px; font-family:monospace; cursor:pointer;'> <a href='?path=%2Flib%2Frpm' style='color:#858585; text-decoration:none; padding:10px 30px; border:1px solid #858585;'>[✗] CANCEL</a></form></div><div style='color:#00ff41; font-family:monospace; text-align:center; padding:20px;'>[~] Kerym Chaeceran</div>