view release on metacpan or  search on metacpan

lib/Evented/API/Engine.pm  view on Meta::CPAN

    $info->{depends}{modules} = \@dep_names;
    return 1 if !@dep_names;

    # check each dependency.
    foreach my $dep_name (@dep_names) {

        # dependency already loaded.
        if ($api->module_loaded($dep_name)) {
            $api->Debug($mod_name,
                "Requirements: Dependency $dep_name already loaded");
            next;
        }

        # prevent endless loops.
        if ($info->{name} eq $dep_name) {
            $api->Log($mod_name, 'Load FAILED: Module depends on itself');
            return;
        }

        # load the dependency.
        $api->Log($mod_name, "Requirements: Loading dependency $dep_name");
        $api->{indent}++;
            my $ok = $api->load_module($dep_name);
        $api->{indent}--;

        # something went wrong.
        next if $ok;
        $api->Log($mod_name,
            "Load FAILED: Loading dependency $dep_name failed");
        return;
    }

    return 1;
}

my $json = JSON::XS->new->canonical->pretty;

# fetch module information.
sub _get_module_info {
    my ($api, $mod_name, $mod_dir, $mod_last_name) = @_;

    # try reading module JSON file.
    my $path  = "$mod_dir/$mod_last_name.json";
    my $slurp = $api->_slurp($mod_name, $path);

    # no file - start with an empty hash.
    my ($info, $use_manifest);
    if (!length $slurp) {
        $api->Debug($mod_name, "No JSON manifest found at $path");
        $info = {};
    }

    # parse JSON. stop here if an error occurs, or if the manifest yields
    # something other than a JSON object.
    elsif (!($info = eval { $json->decode($slurp) }) || ref $info ne 'HASH') {
        $api->Log($mod_name, "Load FAILED: JSON parsing of $path failed: $@");
        $api->Debug($mod_name, "JSON text: $slurp");
        return;
    }

    # JSON was decoded successfully at this point.
    # developer mode is disabled, so return the manifest.
    elsif (!$api->{developer}) {
        $use_manifest++;
    }

    # JSON was decoded successfully, but we're in developer mode.
    # check the modification times. only use the manifest if the module's
    # main package has not been modified since the manifest was written.
    else {
        my $pkg_modified = (stat "$mod_dir/$mod_last_name.pm"  )[9];
        my $man_modified = (stat "$mod_dir/$mod_last_name.json")[9];
        $use_manifest++ if $man_modified >= $pkg_modified;
    }

    # info was determined by JSON manifest.
    if ($use_manifest) {
        $info->{name} = { full => $info->{name} } if !ref $info->{name};
        return $info;
    }

    $api->Debug($mod_name, 'Scanning for metadata');

    # try reading comments.
    open my $fh, '<', "$mod_dir/$mod_last_name.pm"
        or $api->Log($mod_name, "Load FAILED: Could not open file: $!")
        and return;

    # parse for variables.
    my $old_version = $info->{version} || 0;
    my ($new_info, $parsed_lines) = {};
    LINE: while (my $line = <$fh>) {
        next unless $line =~ m/^#\s*@([\.\w]+)\s*(?:([:\+]+)(.+))?$/;
        $parsed_lines++;
        my ($var_name, $sym, $perl_value) = ($1, $2, $3);

        # find the correct hash level.
        my ($i, $current, @s) = (0, $new_info, split /\./, $var_name);
        LEVEL: foreach my $l (@s) {

            # last level, should contain the value.
            if ($i == $#s) {
                my ($is_add, $is_set, $is_bool) = map $sym eq $_, '+', ':', '';

                # for ':' or '+', eval the value now.
                my $eval;
                if ($is_set || $is_add) {
                    $perl_value = "[ $perl_value ]" if $is_add;
                    $eval = eval $perl_value;
                    if ($@) {
                        $api->Log($mod_name,
                            "Load FAILED: Evaluating '\@$var_name' failed: $@");
                        close $fh;
                        return;
                    }
                }

                # for ':', simply set the value.
                if ($is_set) {
                    $current->{$l} = $eval;
                }

                # for '+', add it to a list.
                elsif ($is_add) {
                    $current->{$l} = []
                        if ref $current->{$l} ne 'ARRAY';
                    push @{ $current->{$l} }, @$eval;