Initial Commit

database/perl/lib/CPAN/Exception/RecursiveDependency.pm

@@ -0,0 +1,113 @@
+# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
+# vim: ts=4 sts=4 sw=4:
+package CPAN::Exception::RecursiveDependency;
+use strict;
+use overload '""' => "as_string";
+
+use vars qw(
+            $VERSION
+);
+$VERSION = "5.5001";
+
+{
+    package CPAN::Exception::RecursiveDependency::na;
+    use overload '""' => "as_string";
+    sub new { bless {}, shift };
+    sub as_string { "N/A" };
+}
+
+my $NA = CPAN::Exception::RecursiveDependency::na->new;
+
+# a module sees its distribution (no version)
+# a distribution sees its prereqs (which are module names) (usually with versions)
+# a bundle sees its module names and/or its distributions (no version)
+
+sub new {
+    my($class) = shift;
+    my($deps_arg) = shift;
+    my (@deps,%seen,$loop_starts_with);
+  DCHAIN: for my $dep (@$deps_arg) {
+        push @deps, {name => $dep, display_as => $dep};
+        if ($seen{$dep}++) {
+            $loop_starts_with = $dep;
+            last DCHAIN;
+        }
+    }
+    my $in_loop = 0;
+    my %mark;
+ DWALK: for my $i (0..$#deps) {
+        my $x = $deps[$i]{name};
+        $in_loop ||= $loop_starts_with && $x eq $loop_starts_with;
+        my $xo = CPAN::Shell->expandany($x) or next;
+        if ($xo->isa("CPAN::Module")) {
+            my $have = $xo->inst_version || $NA;
+            my($want,$d,$want_type);
+            if ($i>0 and $d = $deps[$i-1]{name}) {
+                my $do = CPAN::Shell->expandany($d);
+                $want = $do->{prereq_pm}{requires}{$x};
+                if (defined $want) {
+                    $want_type = "requires: ";
+                } else {
+                    $want = $do->{prereq_pm}{build_requires}{$x};
+                    if (defined $want) {
+                        $want_type = "build_requires: ";
+                    } else {
+                        $want_type = "unknown status";
+                        $want = "???";
+                    }
+                }
+            } else {
+                $want = $xo->cpan_version;
+                $want_type = "want: ";
+            }
+            $deps[$i]{have} = $have;
+            $deps[$i]{want_type} = $want_type;
+            $deps[$i]{want} = $want;
+            $deps[$i]{display_as} = "$x (have: $have; $want_type$want)";
+            if ((! ref $have || !$have->isa('CPAN::Exception::RecursiveDependency::na'))
+                && CPAN::Version->vge($have, $want)) {
+                # https://rt.cpan.org/Ticket/Display.html?id=115340
+                undef $loop_starts_with;
+                last DWALK;
+            }
+        } elsif ($xo->isa("CPAN::Distribution")) {
+            my $pretty = $deps[$i]{display_as} = $xo->pretty_id;
+            my $mark_as;
+            if ($in_loop) {
+                $mark_as = CPAN::Distrostatus->new("NO cannot resolve circular dependency");
+            } else {
+                $mark_as = CPAN::Distrostatus->new("NO one dependency ($loop_starts_with) is a circular dependency");
+            }
+            $mark{$pretty} = { xo => $xo, mark_as => $mark_as };
+        }
+    }
+    if ($loop_starts_with) {
+        while (my($k,$v) = each %mark) {
+            my $xo = $v->{xo};
+            $xo->{make} = $v->{mark_as};
+            $xo->store_persistent_state; # otherwise I will not reach
+                                         # all involved parties for
+                                         # the next session
+        }
+    }
+    bless { deps => \@deps, loop_starts_with => $loop_starts_with }, $class;
+}
+
+sub is_resolvable {
+    ! defined shift->{loop_starts_with};
+}
+
+sub as_string {
+    my($self) = shift;
+    my $deps = $self->{deps};
+    my $loop_starts_with = $self->{loop_starts_with};
+    unless ($loop_starts_with) {
+        return "--not a recursive/circular dependency--";
+    }
+    my $ret = "\nRecursive dependency detected:\n    ";
+    $ret .= join("\n => ", map {$_->{display_as}} @$deps);
+    $ret .= ".\nCannot resolve.\n";
+    $ret;
+}
+
+1;

database/perl/lib/CPAN/Exception/blocked_urllist.pm

@@ -0,0 +1,46 @@
+# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
+# vim: ts=4 sts=4 sw=4:
+package CPAN::Exception::blocked_urllist;
+use strict;
+use overload '""' => "as_string";
+
+use vars qw(
+            $VERSION
+);
+$VERSION = "1.001";
+
+
+sub new {
+    my($class) = @_;
+    bless {}, $class;
+}
+
+sub as_string {
+    my($self) = shift;
+    if ($CPAN::Config->{connect_to_internet_ok}) {
+        return qq{
+
+You have not configured a urllist for CPAN mirrors. Configure it with
+
+    o conf init urllist
+
+};
+    } else {
+        return qq{
+
+You have not configured a urllist and do not allow connections to the
+internet to get a list of mirrors.  If you wish to get a list of CPAN
+mirrors to pick from, use this command
+
+    o conf init connect_to_internet_ok urllist
+
+If you do not wish to get a list of mirrors and would prefer to set
+your urllist manually, use just this command instead
+
+    o conf init urllist
+
+};
+    }
+}
+
+1;

database/perl/lib/CPAN/Exception/yaml_not_installed.pm

@@ -0,0 +1,23 @@
+# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
+# vim: ts=4 sts=4 sw=4:
+package CPAN::Exception::yaml_not_installed;
+use strict;
+use overload '""' => "as_string";
+
+use vars qw(
+            $VERSION
+);
+$VERSION = "5.5";
+
+
+sub new {
+    my($class,$module,$file,$during) = @_;
+    bless { module => $module, file => $file, during => $during }, $class;
+}
+
+sub as_string {
+    my($self) = shift;
+    "'$self->{module}' not installed, cannot $self->{during} '$self->{file}'\n";
+}
+
+1;

database/perl/lib/CPAN/Exception/yaml_process_error.pm

@@ -0,0 +1,53 @@
+# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
+# vim: ts=4 sts=4 sw=4:
+package CPAN::Exception::yaml_process_error;
+use strict;
+use overload '""' => "as_string";
+
+use vars qw(
+            $VERSION
+);
+$VERSION = "5.5";
+
+
+sub new {
+    my($class,$module,$file,$during,$error) = @_;
+    # my $at = Carp::longmess(""); # XXX find something more beautiful
+    bless { module => $module,
+            file => $file,
+            during => $during,
+            error => $error,
+            # at => $at,
+          }, $class;
+}
+
+sub as_string {
+    my($self) = shift;
+    if ($self->{during}) {
+        if ($self->{file}) {
+            if ($self->{module}) {
+                if ($self->{error}) {
+                    return "Alert: While trying to '$self->{during}' YAML file\n".
+                        " '$self->{file}'\n".
+                            "with '$self->{module}' the following error was encountered:\n".
+                                "  $self->{error}\n";
+                } else {
+                    return "Alert: While trying to '$self->{during}' YAML file\n".
+                        " '$self->{file}'\n".
+                            "with '$self->{module}' some unknown error was encountered\n";
+                }
+            } else {
+                return "Alert: While trying to '$self->{during}' YAML file\n".
+                    " '$self->{file}'\n".
+                        "some unknown error was encountered\n";
+            }
+        } else {
+            return "Alert: While trying to '$self->{during}' some YAML file\n".
+                    "some unknown error was encountered\n";
+        }
+    } else {
+        return "Alert: unknown error encountered\n";
+    }
+}
+
+1;