view release on metacpan or  search on metacpan

lib/PAUSEx/Log.pm  view on Meta::CPAN

	croak "Method <$method> not found" unless $self->can($method);

	use experimental qw(builtin);
	my $class = builtin::blessed($self);

	no strict 'refs';
	*{"${class}::$method"} = sub { return $_[0]->{$method} };
	goto &{"${class}::$method"};
	}

=encoding utf8

=head1 NAME

PAUSEx::Log - Access the PAUSE log

=head1 SYNOPSIS

	use v5.36;
	use PAUSEx::Log;

	my $start = time;

	FETCH: while( 1 ) {
		last if time - $start > 10 * 60;

		my $entries = PAUSEx::Log->fetch_log();

		MESSAGE: foreach my $entry ( $entries->@* ) {
			next unless $entry->is_for_pauseid( 'BDFOY' );
			say $entry->message;
			last FETCH if ...
			}

		sleep 5*60;
		}

=head1 DESCRIPTION

The Perl Authors Upload Server provides a tail of its log file so
module authors can check the progress of their modules through the
PAUSE process. This might take several minutes from the time of upload,
and I want to monitor the log until I know my latest release has been
seen by PAUSE.

This module fetches that log and digests it in various ways.

=head1 Class methods

=over 4

=item fetch_log( PAUSE_USER, PAUSE_PASS )

Fetch the PAUSE log, using your PAUSE ID and password. You can also
set these in the C<CPAN_PASS> and C<CPAN_PASS> environment variables, which
this function will automatically pick up.

=cut

sub fetch_log ( $class, $user = $ENV{CPAN_USER}, $pass = $ENV{CPAN_PASS} ) {
	state $rc = require Mojo::UserAgent;
	state $ua = Mojo::UserAgent->new;
	state $url_template = 'https://%s:%s@pause.perl.org/pause/authenquery?ACTION=tail_logfile&pause99_tail_logfile_1=5000&pause99_tail_logfile_sub=Tail+characters';
	state $url = sprintf $url_template, $user, $pass;

	my $tx = $ua->get( $url );

	my $entries = $tx->res->dom
		->find( 'div#logs table.table tbody.list tr td.log' )
		->map( 'text' )
		->map( sub { PAUSEx::Log->_parse_log_line($_) } )
		;
	}

sub _new ( $class, $hash, @values ) {
	my @names = $class->names;
	if( @names != @values ) {
		croak "Names mismatch for: $hash->{message}\n  (@names) <- (@values)"
		}

	$hash->@{@names} = @values;

	bless $hash, $class;
	}

=back

=head2 Instance methods

=over 4

=item can( METHOD )

Returns true if the message contains that information since different
types of message have different things they record. For example,
not all messages contain the PAUSE ID

	if( $entry->can('pause_id') ) { ... }

=cut

sub can ($either, $method) {
	state $class_methods = {
		map { $_, 1 } qw(new can parse_log_line parse_message)
		};
	state $common_methods = {
		map { $_, 1 } qw(date time huh version level message id type)
		};

	if( ref $either ) {
		my $instance = { map { $_, 1 } $either->names };
		return 1 if(
			exists $common_methods->{$method} or exists $instance->{$method}
			);
		}
	else {
		return 1 if exists $class_methods->{$method};
		}
	}

=item date