view release on metacpan or  search on metacpan

lib/App/lcpan.pm  view on Meta::CPAN

            cmdline_aliases => {
                F => {
                    summary => 'Alias for --skip-index-file',
                    code => sub {
                        $_[0]{skip_index_files} //= [];
                        push @{ $_[0]{skip_index_files} }, $_[1];
                    },
                },
            },
            examples => ['Foo-Bar-1.23.tar.gz'],
        },
        skip_index_file_patterns => {
            summary => 'Skip one or more file patterns from being indexed',
            'x.name.is_plural' => 1,
            'summary.alt.plurality.singular' => 'Specify a file pattern to skip from being indexed',
            schema => ['array*', of=>'re*'],
            cmdline_aliases => {
            },
            examples => ['^Foo-Bar-\d'],
        },
        skip_sub_indexing_files => {
            summary => 'Skip one or more files from being parsed for subs',
            'x.name.is_plural' => 1,
            'x.name.singular' => 'skip_sub_indexing_file',
            'summary.alt.plurality.singular' => 'Skip a file from being parsed for subs',
            schema => ['array*', of=>'str*'],
            examples => ['Foo-Bar-1.23.tar.gz'],
        },
        skip_sub_indexing_file_patterns => {
            summary => 'Skip one or more file patterns from being parsed for subs',
            'x.name.is_plural' => 1,
            'x.name.singular' => 'skip_sub_indexing_file_pattern',
            'summary.alt.plurality.singular' => 'Specify a file pattern to skip being parsed for subs',
            schema => ['array*', of=>'re*'],
            cmdline_aliases => {
            },
            examples => ['^Foo-Bar-\d'],
        },
        skip_file_indexing_pass_1 => {
            schema => 'bool*',
        },
        skip_file_indexing_pass_2 => {
            schema => 'bool*',
        },
        skip_file_indexing_pass_3 => {
            schema => 'bool*',
        },
        skip_sub_indexing => {
            schema => ['bool'],
            default => 1,
            description => <<'_',

Since sub indexing is still experimental, it is not enabled by default. To
enable it, pass the `--no-skip-sub-indexing` option.

_
        },
    },
    tags => ['write-to-db', 'write-to-fs'],
};
sub update {
    my %args = @_;
    _set_args_default(\%args);
    my $cpan = $args{cpan};

    my $packages_path = "$cpan/modules/02packages.details.txt.gz";
    my @st1 = stat($packages_path);
    if (!$args{update_files}) {
        log_info("Skipped updating files (reason: option update_files=0)");
    } else {
        _update_files(%args); # it only returns 200 or dies
    }
    my @st2 = stat($packages_path);

    if (!$args{update_index} && !$args{force_update_index}) {
        log_info("Skipped updating index (reason: option update_index=0)");
    } elsif (!$args{force_update_index} && $args{update_files} &&
                 @st1 && @st2 && $st1[9] == $st2[9] && $st1[7] == $st2[7]) {
        log_info("%s doesn't change mtime/size, skipping updating index",
                    $packages_path);
        return [304, "Files did not change, index not updated"];
    } else {
        my $res = _update_index(%args);
        return $res unless $res->[0] == 200;
    }
    [200, "OK"];
}

sub _table_exists {
    my ($dbh, $schema, $name) = @_;
    my $sth = $dbh->table_info(undef, $schema, $name, undef);
    $sth->fetchrow_hashref ? 1:0;
}

sub _reset {
    # this sub is used since v7, so we need to check tables that have not
    # existed in v7 or earlier.
    my ($dbh, $soft) = @_;
    $dbh->do("DELETE FROM dep");
    $dbh->do("DELETE FROM namespace");
    $dbh->do("DELETE FROM mention")   if _table_exists($dbh, "main", "mention");
    $dbh->do("DELETE FROM module");
    $dbh->do("DELETE FROM old_module")if _table_exists($dbh, "main", "old_module");
    $dbh->do("DELETE FROM script")    if _table_exists($dbh, "main", "script");
    $dbh->do("DELETE FROM old_script")if _table_exists($dbh, "main", "old_script");
    $dbh->do("DELETE FROM sub")       if _table_exists($dbh, "main", "sub");
    $dbh->do("DELETE FROM dist")      if _table_exists($dbh, "main", "dist");
    $dbh->do("DELETE FROM content")   if _table_exists($dbh, "main", "content");
    $dbh->do("DELETE FROM file");
    $dbh->do("DELETE FROM old_file")  if _table_exists($dbh, "main", "old_file");
    $dbh->do("DELETE FROM author");
    $dbh->do("DELETE FROM log")       if _table_exists($dbh, "main", "log") && !$soft;

    $dbh->do("DELETE FROM meta WHERE name='index_creation_time'") if !$soft;
}

$SPEC{'reset'} = {
    v => 1.1,
    summary => 'Reset (empty) the database index',
    description => <<'_',