DateTime results from the CPAN

DateTime

App-ListNewCPANDists

view release on metacpan or search on metacpan

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

package App::ListNewCPANDists;

use 5.010001;
use strict;
use warnings;
use Log::ger;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2023-03-28'; # DATE
our $DIST = 'App-ListNewCPANDists'; # DIST
our $VERSION = '0.023'; # VERSION

our %SPEC;

my $sch_date = ['date*', 'x.perl.coerce_to' => 'DateTime', 'x.perl.coerce_rules'=>['From_str::natural']];

our $db_schema_spec = {
    summary => __PACKAGE__,
    latest_v => 2,
    install => [
        'CREATE TABLE dist (
            name TEXT NOT NULL PRIMARY KEY,
            first_version TEXT NOT NULL,
            first_time INTEGER NOT NULL,
            latest_version TEXT NOT NULL,
            latest_time INTEGER NOT NULL,
            mtime INTEGER NOT NULL
        )',
    ],
    install_v1 => [
        'CREATE TABLE release (
            name TEXT NOT NULL PRIMARY KEY,
            dist TEXT NOT NULL,
            time INTEGER NOT NULL
        )',
        'CREATE UNIQUE INDEX ix_release__dist ON release(name,dist)',
    ],
    upgrade_to_v2 => [
        'DROP TABLE release',
        'CREATE TABLE dist (
            name TEXT NOT NULL PRIMARY KEY,
            first_version TEXT NOT NULL,
            first_time INTEGER NOT NULL,
            latest_version TEXT NOT NULL,
            latest_time INTEGER NOT NULL,
            mtime INTEGER NOT NULL
        )',
    ],
};

our %args_common = (
    cpan => {
        summary => 'Location of your local CPAN mirror, e.g. /path/to/cpan',
        schema => 'dirname*',
        description => <<'_',

Defaults to `~/cpan`. This actually does not need to be a real CPAN local
mirror, but can be just an empty directory. If you use happen to use
<pm:App::lcpan>, you can use the local CPAN mirror generated by <prog:lcpan>
(which also defaults to `~/cpan`) to store the database.

_
        tags => ['common', 'category:local-cpan'],
    },
    db_name => {
        summary => 'Filename of database',
        schema =>'filename*',
        default => 'index-lncd.db',
        tags => ['common', 'category:db'],
    },
);

our %args_filter = (
    exclude_dists => {
        'x.name.is_plural' => 1,

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

Monday is the start of the week.

_
            tags => ['category:time-filtering'],
        },
        this_month => {
            schema => 'true*',
            tags => ['category:time-filtering'],
        },
        this_year => {
            schema => 'true*',
            tags => ['category:time-filtering'],
        },
        yesterday => {
            schema => 'true*',
            tags => ['category:time-filtering'],
        },
        last_week => {
            schema => 'true*',
            description => <<'_',

Monday is the start of the week.

_
            tags => ['category:time-filtering'],
        },
        last_month => {
            schema => 'true*',
            tags => ['category:time-filtering'],
        },
        last_year => {
            schema => 'true*',
            tags => ['category:time-filtering'],
        },
    },
    args_rels => {
        req_one => [qw/today this_week this_month this_year yesterday last_week last_month last_year from_time/],
    },
    examples => [
        {
            summary => 'Show new distributions from Jan 1, 2019 to the present',
            argv => ['2019-01-01'],
            'x.doc.show_result' => 0,
            test => 0,
        },
        {
            summary => "Show PERLANCAR's new distributions this year",
            argv => ['--include-author', 'PERLANCAR', '--this-year'],
            'x.doc.show_result' => 0,
            test => 0,
        },
        {
            summary => "What are the new releases last month?",
            argv => ['--last-month'],
            'x.doc.show_result' => 0,
            test => 0,
        },
    ],
};
sub list_new_cpan_dists {
    require DateTime;

    my %args = @_;

    my $state = _init(\%args);
    my $dbh = $state->{dbh};

    my $today = DateTime->today;
    my $now = DateTime->now;
    my $end_of_yesterday = $now->clone->add(days => -1)->set(hour => 23, minute => 59, second => 59);
    my $to_time   = $args{to_time} // $now->clone;

    my $from_time;
    if ($args{from_time}) {
        $from_time = $args{from_time};
    } elsif ($args{today}) {
        $from_time = $today;
    } elsif ($args{this_week}) {
        my $dow   = $today->day_of_week;
        $from_time = $today->clone->add(days => -($dow-1));
    } elsif ($args{this_month}) {
        $from_time = $today->clone->set(day => 1);
    } elsif ($args{this_year}) {
        $from_time = $today->set(day => 1, month => 1);
    } elsif ($args{yesterday}) {
        $from_time = $today->add(days => -1);
        $to_time   = $end_of_yesterday;
    } elsif ($args{last_week}) {
        my $dow   = $today->day_of_week;
        my $start_of_last_week = $today->clone->add(days => -($dow-1))->add(days => -7);
        my $end_of_last_week   = $start_of_last_week->clone->add(days => 7)->add(seconds => -1);
        $from_time = $start_of_last_week;
        $to_time   = $end_of_last_week;
    } elsif ($args{last_month}) {
        $from_time = $today->clone->set(day => 1)->add(months => -1);
        $to_time   = $today->clone->set(day => 1)->add(seconds => -1);
    } elsif ($args{last_year}) {
        $from_time = $today->clone->set(day => 1, month => 1)->add(years => -1);
        $to_time   = $today->clone->set(day => 1, month => 1)->add(seconds => -1);
    } else {
        return [400, "Please specify today/yesterday/{this,last}_{week,month,year}/from_time"];
    }

    #if (!$to_time) {
    #    $to_time = $from_time->clone;
    #    $to_time->set_hour(23);
    #    $to_time->set_minute(59);
    #    $to_time->set_second(59);
    #}
    if ($args{-orig_to_time} && $args{-orig_to_time} !~ /T\d\d:\d\d:\d\d/) {
        $to_time->set_hour(23);
        $to_time->set_minute(59);
        $to_time->set_second(59);
    }

    log_trace("Retrieving releases from %s to %s ...",
              $from_time->datetime, $to_time->datetime);

    require App::MetaCPANUtils;
    my $api_res = App::MetaCPANUtils::list_metacpan_releases(
        from_date => $from_time,
        to_date => $to_time,
        fields => [qw/author date distribution abstract first/],
        sort => 'release',
    );

    #fields => [qw/name author distribution abstract date version version_numified/],

    return [500, "Can't list MetaCPAN releases: $api_res->[0] - $api_res->[1]"]

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


    [200, "OK", \@rows, \%resmeta];
}

$SPEC{create_new_cpan_dists_stats} = {
    v => 1.1,
    args => {
        dists => {
            schema => 'array*',
        },
    },
};
sub create_new_cpan_dists_stats {
    my %args = @_;
    my $dists = $args{dists};

    my %authors;
    for my $dist (@$dists) {
        $authors{$dist->{author}} //= {num_dists => 0};
        $authors{$dist->{author}}{num_dists}++;
    }
    my @authors_by_num_dists = map {
        +{author=>$_, num_dists=>$authors{$_}{num_dists}}
    } sort { $authors{$b}{num_dists} <=> $authors{$a}{num_dists} }
    keys %authors;
    my $num_authors = keys %authors;

    my $stats = {
        "Number of new CPAN distributions this period" => scalar(@$dists),
        "Number of authors releasing new CPAN distributions this period" => $num_authors,
        "Authors by number of new CPAN distributions this period" => \@authors_by_num_dists,
    };

    [200, "OK", $stats];
}

$SPEC{list_monthly_new_cpan_dists} = {
    v => 1.1,
    summary => 'List new CPAN distributions in a given month',
    description => <<'_',

Like `list_new_cpan_dists` but you only need to specify month and year instead
of starting and ending time period.

_
    args => {
        %args_filter,
        month => {
            schema => ['int*', min=>1, max=>12],
            req => 1,
            pos => 0,
        },
        year => {
            schema => ['int*', min=>1990, max=>9999],
            req => 1,
            pos => 1,
        },
    },
};
sub list_monthly_new_cpan_dists {
    require DateTime;
    require Time::Local;

    my %args = @_;

    my $mon = delete $args{month};
    my $year = delete $args{year};
    my $from_time = Time::Local::timegm(0, 0, 0, 1, $mon-1, $year);
    $mon++; if ($mon == 13) { $mon = 1; $year++ }
    my $to_time = Time::Local::timegm(0, 0, 0, 1, $mon-1, $year) - 1;
    list_new_cpan_dists(
        %args,
        from_time => DateTime->from_epoch(epoch => $from_time),
        to_time   => DateTime->from_epoch(epoch => $to_time),
        (exclude_dists      => $args{exclude_dists}     ) x !!defined($args{exclude_dists}),
        (exclude_dists_re   => $args{exclude_dists_re}  ) x !!defined($args{exclude_dists_re}),
        (exclude_authors    => $args{exclude_authors}   ) x !!defined($args{exclude_authors}),
        (exclude_authors_re => $args{exclude_authors_re}) x !!defined($args{exclude_authors_re}),
    );
}

sub _htmlize {
    require HTML::Entities;

    my $res = shift;

    my @html;

    push @html, "<table>\n";

    my $cols = $res->[3]{'table.fields'};
    push @html, "<tr>\n";
    for my $col (@$cols) {
        next if $col =~ /\A(first|latest)_(time)\z/;
        push @html, "<th>$col</th>\n";
    }
    push @html, "</tr>\n\n";

    {
        no warnings 'uninitialized';
        for my $row (@{ $res->[2] }) {
            push @html, "<tr>\n";
            for my $col (@$cols) {
                next if $col =~ /\A(first|latest)_(time)\z/;
                my $cell = HTML::Entities::encode_entities($row->{$col});
                if ($col eq 'author') {
                    $cell = qq(<a href="https://metacpan.org/author/$cell">$cell</a>);
                } elsif ($col eq 'dist') {
                    $cell = qq(<a href="https://metacpan.org/release/$row->{dist}">$cell</a>);
                }
                push @html, "<td>$cell</td>\n";
            }
            push @html, "</tr>\n";
        }
        push @html, "</table>\n";

        # stats
        my $stats = $res->[3]{'func.stats'};
        push @html, "<h3>Stats</h3>\n";
        push @html, "<p>Number of new CPAN distributions this period: <b>", $stats->{"Number of new CPAN distributions this period"}, "</b></p>\n";
        push @html, "<p>Number of authors releasing new CPAN distributions this period: <b>", $stats->{"Number of authors releasing new CPAN distributions this period"}, "</b></p>\n";
        push @html, "<p>Authors by number of new CPAN distributions this period: </p>\n";
        push @html, "<table>\n";
        push @html, "<tr><th>No</th><th>Author</th><th>Distributions</th></tr>\n";
        my $i = 1;
        for my $rec (@{ $stats->{"Authors by number of new CPAN distributions this period"} }) {
            push @html, qq(<tr><td>$i</td><td><a href="https://metacpan.org/author/$rec->{author}">$rec->{author}</a></td><td>$rec->{num_dists}</td></tr>\n);
            $i++;
        }
        push @html, "</table>\n";
    }

    [200, "OK", join("", @html), {'cmdline.skip_format'=>1}];
}

( run in 0.440 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )