view release on metacpan or  search on metacpan

lib/Perl/ToPerl6/TransformerFactory.pm  view on Meta::CPAN

                for my $_name ( keys %{ $preferences->{$name}{after} } ) {

                    # If it needs to run after a module we haven't placed in
                    # order, then abandon the loop.
                    #
                    if ( !exists $final{$_name} ) {
                        $max = -1;
                        last;
                    }
                    $max = max($final{$_name},$max);
                }

                # If we haven't abandoned the loop, then
                # add the module *after* the last module in order
                # and delete the module from the preferences list.
                #
                if ( $max >= 0 ) {
                   $final{$name} = $max + 1;
                   delete $preferences->{$name};
                }
            }

            # The module doesn't need to be run after any given module.
            # So put it directly on the list, in group 0.
            #
            else {
               $final{$name} = 0;
               delete $preferences->{$name};
            }
        }
    }

    # If there are any keys remaining in the preferences array, it's possible
    # that the algorithm didn't sort dependencies correctly, but it is
    # vastly more likely to be the case that we've encountered a cycle.
    # Die, telling the user what happened.
    #
    if ( keys %{ $preferences } ) {
        die "Found a preference loop among: " . join("\n", keys %{ $preferences });
    }

    my %inverse;
    push @{$inverse{$final{$_}}}, $_ for keys %final;
    for ( sort keys %inverse ) {
        push @ordered, map { $object{$_} } @{$inverse{$_}};
    }

    return @ordered;
}

#-----------------------------------------------------------------------------
# Some static helper subs

sub _modules_from_blib {
    my (@modules) = @_;
    return grep { _was_loaded_from_blib( _module2path($_) ) } @modules;
}

sub _module2path {
    my $module = shift || return;
    return File::Spec::Unix->catdir(split m/::/xms, $module) . '.pm';
}

sub _was_loaded_from_blib {
    my $path = shift || return;
    my $full_path = $INC{$path};
    return $full_path && $full_path =~ m/ (?: \A | \b b ) lib \b /xms;
}

#-----------------------------------------------------------------------------

sub new {

    my ( $class, %args ) = @_;
    my $self = bless {}, $class;
    $self->_init( %args );
    return $self;
}

#-----------------------------------------------------------------------------

sub _init {

    my ($self, %args) = @_;

    my $profile = $args{-profile};
    $self->{_profile} = $profile
        or throw_internal q{The -profile argument is required};

    my $incoming_errors = $args{-errors};
    my $profile_strictness = $args{'-profile-strictness'};
    $profile_strictness ||= $PROFILE_STRICTNESS_DEFAULT;
    $self->{_profile_strictness} = $profile_strictness;

    if ( $profile_strictness ne $PROFILE_STRICTNESS_QUIET ) {
        my $errors;

        # If we're supposed to be strict or problems have already been found...
        if (
                $profile_strictness eq $PROFILE_STRICTNESS_FATAL
            or  ( $incoming_errors and @{ $incoming_errors->exceptions() } )
        ) {
            $errors =
                $incoming_errors
                    ? $incoming_errors
                    : Perl::ToPerl6::Exception::AggregateConfiguration->new();
        }

        $self->_validate_transformers_in_profile( $errors );

        if (
                not $incoming_errors
            and $errors
            and $errors->has_exceptions()
        ) {
            $errors->rethrow();
        }
    }

    return $self;
}