App-KGB

 view release on metacpan or  search on metacpan

lib/App/KGB/Client.pm  view on Meta::CPAN

in Git-hosted sub-projects that want to share single configuration file, but
still want module indication in notifications.

=item B<single_line_commits> I<off|forced|auto>

Request different modes of commit message processing:

=over

=item I<off>

No processing is done. The commit message is printed as was given, with each
line in a separate IRC message, blank lines omitted. This is the only possible
behaviour in versions before 1.14.

=item I<forced>

Only the first line is sent to IRC, regardless of whether it is followed by a
blank line or not.

=item I<auto>

If the first line is followed by an empty line, only the first line is sent to
IRC and the rest is ignored. This is the default since version 1.14.

=back

=item B<use_irc_notices>

If true signals the server that it should use IRC notices instead of regular
messages. Use this if regular messages are too distracting for your channel.

=item B<use_color>

If true (the default) signals the server that it should use colors for commit
notifications.

=item B<status_dir>

Specifies a directory to store information about the last server contacted
successfully. The client would touch files in that directory after successful
completion of a notification with remote server.

Later, when asked to do another notification, the client would start from the
most recently contacted server. If that was contacted too far in the past, the
information in the directory is ignored and a random server is picked, as
usual.

=item B<verbose>

Print diagnostic information.

=item B<protocol> I<version>

Use specified protocol version. If C<auto> (the default), the version of the
protocol C<2>, unless B<web_link> is also given, in which case protocol version
C<3> is default;

=item B<web_link> I<template>

A web link template to be sent to the server. The following items are expanded:

=over

=item ${branch}

=item ${module}

=item ${commit}

=item ${project}

=back

=item B<short_url_service> I<service>

A L<WWW::Shorten> service to use for shortening the B<web_link>. See
L<WWW::Shorten> for the list of supported services.

=item B<msg_template> I<string>

Provides a way to customize the notifications' appearance on IRC. When present,
all message construction is done on the client and the prepared messages
(possibly with colors etc) are sent to the server for relaying to IRC.

The following special items are recognized and replaced with the respective
commit elements.

=over

=item ${project_id}

The ID of the project.

=item ${author_login}

The login of the author (e.g. "joe").

=item ${author_name}

The name of the commit author (e.g. "Joe Random")

=item ${author_via}

The name of the commit author, plus the name of the committer if that is
different (e.g. "Joe Random" or "Joe Random (via Max Random)")

=item ${branch}

The branch of the commit.

=item ${module}

The module of the commit.

=item ${commit}
=item ${revision}

The ID of the commit.

=item ${path}

lib/App/KGB/Client.pm  view on Meta::CPAN

    my @servers = List::Util::shuffle( @{ $self->servers } );

    if ( $self->_last_server ) {
        # just put the last server first in the list
        @servers = sort {
            return -1 if $a->uri eq $self->_last_server->uri;
            return +1 if $b->uri eq $self->_last_server->uri;
            return 0;
        } @servers;
    }
    elsif ( $self->status_dir ) {
        # pick a server from the status directory
        my %hashes;
        do {
            my $i = 0;
            for (@servers) {
                $hashes{ md5_hex( $_->uri ) } = $i++;
            }
        };
        my $d = DirHandle->new( $self->status_dir );
        my $latest_stamp;
        my $latest_hash;
        if ( defined $d ) {
            my $now = time;
            while( defined( my $f = $d->read ) ) {
                next
                    unless $f =~ /^kgb-client.([0-9a-f]+)$/
                        and exists( $hashes{$1} );

                my $file = File::Spec->catdir($self->status_dir, $f);

                my $stamp = (stat $file)[9];

                if ( $latest_stamp ) {
                    if( $latest_stamp < $stamp ) {
                        $latest_stamp = $stamp;
                        $latest_hash = $1;
                    }
                }
                elsif ( $stamp >= ( $now - 300 ) ) {
                    # accessed in the last 5 minutes, consider it
                    $latest_stamp = $stamp;
                    $latest_hash  = $1;
                }
            }

            if ( $latest_stamp ) {
                my $winner = splice( @servers, $hashes{$latest_hash}, 1 );
                unshift @servers, $winner;
            }
        }
        else {
            warn "Unable to read directory ".$self->status_dir."\n";
            $self->status_dir(undef);
        }
    }

    return @servers;
}

=item expand_link ($string, \%data)

Expands items in the form I<${item}> in I<$string>, using the data in the
supplied hash reference.

Passing

 "http://git/${module}.git?commit=${commit}",
 { module => 'dh-make-perl', commit => '225ceca' }

would result in C<http://git/dh-make-perl.git?commit=225ceca>.

=cut

sub expand_link {
    my ( $self, $input, $data ) = @_;

    my $output = '';
    my $re = qr/\$\{([^{}]+)\}/p;

    while ( $input =~ $re ) {
        my $f = $1;
        my $v;
        if ( exists $data->{$f} ) {
            $v = $data->{$f} // '';
        }
        else {
            $v = '';
            warn "Unknown substitution '$f'\n";
        }

        $output .= ${^PREMATCH} . $v;
        $input = ${^POSTMATCH};
    }

    warn "Web link expanded to $output\n" if $self->verbose;

    return $output;
}

=item shorten_url (url)

Uses the configured I<short_url_service> to shorten the given URL. If no
shortening service is configured, the original URL is returned.

=cut

sub shorten_url {
    my ( $self, $url ) = @_;
    return $url unless my $service = $self->short_url_service;

    my $ok = eval {
        require WWW::Shorten;
        WWW::Shorten->import( $service, ':short' );
        1;
    };

    unless ($ok) {
        warn "Unable to load URL shortening service '$service': $@";
        warn "Sending plain URL.\n";
        return $url;
    }

    my $short_url = short_link($url);

    return $short_url if defined($short_url);

    warn "URL shortening service '$service' failed.\n";
    warn "Sending plain URL.\n";
    return $url;
}

=item note_last_server($srv)

If C<status_dir> is configured, notes $srv as the last used server to be used
in subsequent requests.

=cut

sub note_last_server {
    my ( $self, $srv ) = @_;

    return unless $self->status_dir;

    require File::Touch;
    File::Touch::touch(
        File::Spec->catfile(
            $self->status_dir,
            sprintf( "kgb-client.%s", md5_hex( $srv->uri ) )
        )
    );
}

use constant rev_prefix => '';

=item init_painter

lib/App/KGB/Client.pm  view on Meta::CPAN

        elsif ( $token eq 'changes' ) {
            push @r, '' => $self->colorize_changes( $commit->changes )
                if $commit and $commit->changes;
        }
        else {
            push @r, '' => "Unknown item '$_'";
        }

        my ( $category, $item ) = @r;

        warn "# item = '$item'" if 0;
        next unless defined($item) and $item ne '';

        if ( defined($pre) ) {
            # avoid adding multi-spaces or spaces at the beginning
            $pre =~ s/^\s+// if $result =~ /\s$/ or $result eq '';
            $result .= $pre;
        }
        $result .=
            ( $category eq '' )
            ? $item
            : $self->colorize( $category => $item );
        $result .= $post // '';
    }
    $result .= $msg;

    return $result;
}

=item process_commit ($commit)

Processes a single commit, returning something for sending to the remote
server. I<Something> is either a reference to array of arguments to be passed
to L<App::KGB::ServerRef>'s send_changes method, or, in message-relay mode, a
plain scalar string representing the commit.

If $commit is a plain scalar (not a reference), then it is assumed to be an
already processed string and is returned directly.

=cut

sub process_commit {
    my ( $self, $commit ) = @_;

    # plain strings are already processed by the VCS-specific module
    return $commit unless ref($commit);

    my $module = $self->module // $commit->module;
    my $branch = $commit->branch;

    if ( not defined($module) or not defined($branch) ) {
        my ( $det_branch, $det_module )
            = $self->detect_branch_and_module( $commit->changes );

        $branch //= $det_branch;
        $module //= $det_module;
    }

    my $web_link = $self->web_link;
    if ( defined($web_link) ) {
        $web_link = $self->expand_link(
            $web_link,
            {   branch  => $branch,
                module  => $module,
                commit  => $commit->id,
                project => $self->repo_id
            }
        );
        $web_link = $self->shorten_url($web_link);
    }

    $branch = undef
        if $branch and $branch eq ( $self->ignore_branch // '' );

    # All data prepared. Now, how do we represent this commit?

    # A pre-formatted, pre-coloured string, if msg_template is configured
    return $self->format_message(
        $self->msg_template,
        commit   => $commit,
        branch   => $branch,
        module   => $module,
        web_link => $web_link
    ) if $self->msg_template;

    # otherwise, prepare things for send_changes()
    my @args = ( $commit, $branch, $module );
    my %extra;
    $extra{web_link} = $web_link if defined($web_link);
    $extra{use_irc_notices} = $self->use_irc_notices
        if $self->use_irc_notices;
    $extra{use_color} = $self->use_color;
    push @args, \%extra if %extra;

    return \@args;
}

=item process

The main processing method. Calls B<describe_commit> and while it returns true
values, gives them to B<process_commit> and send the result to the server.

If B<batch_messages> flag is true, relays accumulated messages after
processing.

=cut

sub process {
    my $self = shift;

    my @messages;

    while ( my $commit = $self->describe_commit ) {
        my $data = $self->process_commit($commit);

        if (ref($data)) {
            # a structure to be interpreted by the server
            $self->send_changes($data);
        }
        else {
            # a plain string