view release on metacpan or  search on metacpan

lib/App/Sqitch/Command/show.pm  view on Meta::CPAN

has exists_only => (
    is       => 'ro',
    isa      => Bool,
    default  => 0,
);

sub options {
    return qw(
        target|t=s
        exists|e!
    );
}

sub configure {
    my ( $class, $config, $opt ) = @_;
    $opt->{exists_only} = delete $opt->{exists}
        if exists $opt->{exists};
    return $class->SUPER::configure( $config, $opt );
}

sub execute {
    my ( $self, $type, $key ) = @_;
    $self->usage unless $type && $key;

    require App::Sqitch::Target;
    my $target = $self->target ? App::Sqitch::Target->new(
        $self->target_params,
        name   => $self->target,
    ) : $self->default_target;
    my $plan = $target->plan;

    # Handle tags first.
    if ( $type eq 'tag' ) {
        my $is_id = $key =~ /^[0-9a-f]{40}/;
        my $change = $plan->get(
            $is_id ? $key : ($key =~ /^@/ ? '' : '@') . $key
        );

        my $tag = $change ? do {
            if ($is_id) {
                # It's a tag ID.
                first { $_->id eq $key } $change->tags;
            } else {
                # Tag name.
                (my $name = $key) =~ s/^[@]//;
                first { $_->name eq $name } $change->tags;
            }
        } : undef;
        unless ($tag) {
            return if $self->exists_only;
            hurl show => __x( 'Unknown tag "{tag}"', tag => $key );
        }
        $self->emit( $tag->info ) unless $self->exists_only;
        return $self;
    }

    # Make sure we recognize the type.
    hurl show => __x(
        'Unknown object type "{type}',
        type => $type,
    ) unless first { $type eq $_ } qw(change deploy revert verify);

    # Make sure we have a change object.
    my $change = $plan->get($key) or do {
        return if $self->exists_only;
        hurl show => __x(
            'Unknown change "{change}"',
            change => $key
        );
    };

    if ($type eq 'change') {
        # Just show its info.
        $self->emit( $change->info ) unless $self->exists_only;
        return $self;
    }

    my $meth = $change->can("$type\_file");
    my $path = $change->$meth;
    unless (-e $path) {
        return if $self->exists_only;
        hurl show => __x('File "{path}" does not exist', path => $path);
    }
    hurl show => __x('"{path}" is not a file', path => $path)
        if $path->is_dir;

    return $self if $self->exists_only;

    # Assume nothing about the encoding.
    binmode STDOUT, ':raw';
    $self->emit( $path->slurp(iomode => '<:raw') );
    return $self;
}

1;

__END__

=head1 Name

App::Sqitch::Command::show - Show Sqitch changes to a database

=head1 Synopsis

  my $cmd = App::Sqitch::Command::show->new(%params);
  $cmd->execute($type, $name);

=head1 Description

Shows the content of a Sqitch object.

If you want to know how to use the C<show> command, you probably want to be
reading C<sqitch-show>. But if you really want to know how the C<show> command
works, read on.

=head1 Interface

=head2 Class Methods

=head3 C<options>