# ABSTRACT: Run a cme script

package App::Cme::Command::run ;

use strict;
use warnings;
use v5.20;
use File::HomeDir;
use Path::Tiny;
use Config::Model;
use Config::Model::Lister;
use Log::Log4perl qw(get_logger :levels);
use YAML::PP;

use Encode qw(decode_utf8);

use App::Cme -command ;

use base qw/App::Cme::Common/;
use feature qw/postderef signatures/;

my $__test_home = '';
# used only by tests
## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
sub _set_test_home { $__test_home = shift; return;}

my $home = $__test_home || File::HomeDir->my_home;

my @script_paths = map {path($_)} (
    "$home/.cme/scripts",
    "/etc/cme/scripts/",
);

push @script_paths, path($INC{"Config/Model.pm"})->parent->child("Model/scripts") ;

sub opt_spec {
    my ( $class, $app ) = @_;
    return ( 
        [ "arg=s@"  => "script argument. run 'cme run <script> -doc' for possible arguments" ],
        [ "backup:s"  => "Create a backup of configuration files before saving." ],
        [ "foreach=s" => "Run script in several directories. The list of directories "
          . "must be passed as a single argument, i.e. --foreach 'foo bar'" ],
        [ "commit|c:s" => "commit change with passed message" ],
        [ "cat" => "Show the script file" ],
        [ "no-commit|nc!" => "skip commit to git" ],
        [ "doc!"    => "show documention of script" ],
        [ "list!"   => "list available scripts" ],
        $class->cme_global_options,
    );
}

sub validate_args {
    my ($self, $opt, $args) = @_;

    $self->check_unknown_args($args);
    return;
}

sub usage_desc {
  my ($self) = @_;
  my $desc = $self->SUPER::usage_desc; # "%c COMMAND %o"
  return "$desc [ script ] [ -args foo=12 [ -args bar=13 ]";
}

sub description {
    my ($self) = @_;
    return $self->get_documentation;
}

sub check_script_arguments ($self, $opt, $script_name) {
    if ($opt->{list} or not $script_name) {
        my @scripts;
        foreach my $path ( @script_paths ) {
            next unless $path->is_dir;
            push @scripts, map {$_->basename} grep { ! /~$/ } $path->children();
        }
        say $opt->{list} ? "Available scripts:" : "Missing script argument. Choose one of:";
        foreach my $script_path (sort @scripts) {
            my $data = $self->get_script_data($script_path);
            printf("- %s (app: %s)\n",$script_path, $data->{app} );
        }
        say "";
        say "Run 'cme run <script> -doc' to get more details on a script.";
        return 0;
    }
    return 1;
}

sub find_script_file ($self, $script_name) {
    my $script;
    if ($script_name =~ m!/!) {
        $script = path($script_name);
    }
    else {
        # check script in known locations
        foreach my $path ( @script_paths ) {
            next unless $path->is_dir;
            $script = $path->child($script_name);
            last if $script->is_file;
        }
    }

    die "Error: cannot find script $script_name\n" unless $script->is_file;

    return $script;
}

## no critic (Subroutines::ProhibitManyArgs)
sub replace_var_in_value ($user_args, $script_var, $data, $value) {
    state $var_pattern = qr~(?<!\\) \$([a-zA-Z]\w+) (?!\s*{)~x;

    # change $var but not \$var, not $var{} and not $1
    $value =~ s~ $var_pattern
               ~ $user_args->{$1} // $script_var->{$1} // $ENV{$1} // $data->{default}{$1} // '$'.$1 ~xeg;

    # register vars without replacements
    foreach my $var ($value =~ m~ $var_pattern ~xg) {
        $data->{missing}{$var} = 1 ;
    }

    # now change \$var in $var
    $value =~ s!\\\$!\$!g;

    return $value;
}

# replace variables with command arguments or eval'ed variables or env variables
## no critic (Subroutines::ProhibitManyArgs)
sub replace_vars ($user_args, $script_var, $data, @items) {
    foreach my $item (@items) {
        if (ref $data->{$item}  eq 'ARRAY') {
            my @new;
            foreach my $value ($data->{$item}->@*) {
                push @new, replace_var_in_value ($user_args, $script_var, $data, $value);
            }
            $data->{$item} = \@new;
        }
        elsif ($data->{$item}) {
            $data->{$item} = replace_var_in_value ($user_args, $script_var, $data, $data->{$item});
        }
    }
    return;
}

sub parse_script_lines ($script, $lines) {
    my $parsed_data = {
        app => '',
        doc => [],
        code => [],
        commit_msg => '',
        # provide default values
        default => {},
        load => [],
        var => [],
    };

    my $line_nb = 0;

    # check content, store app
    while ($lines->@*) {
        my $line = shift $lines->@*;
        $line_nb++;
        $line =~ s/#.*//; # remove comments
        $line =~ s/^\s+//;
        $line =~ s/\s+$//;
        my ($key,@value);

        if ($line =~ /^---\s*(\w+)$/) {
            $key = $1;
            while ($lines->[0] !~ /^---/) {
                $lines->[0] =~ s/#.*//; # remove comments
                push @value,  shift $lines->@*;
            }
        }
        elsif ($line eq '---') {
            next;
        }
        else {
            ($key,@value) = split /[\s:]+/, $line, 2;
        }

        next unless $key ; # empty line

        parse_command($key, $parsed_data, $line_nb, \@value)
            or die "Error in cme DSL file $script line $line_nb: unexpected '$key' instruction\n";
    }

    return $parsed_data;
}

sub parse_command ($key, $parsed_data, $line_nb, $value) {
    ## no critic (ControlStructures::ProhibitCascadingIfElse)
    if ( $key =~ /^app/ ) {
        $parsed_data->{app} = $value->[0];
    }
    elsif ( $key eq 'var' ) {
        push $parsed_data->{var}->@*, [ $line_nb, $value->@* ];
    }
    elsif ( $key eq 'default' ) {
        # multi-line default value is not supported
        my ( $dk, $dv ) = split /[\s:=]+/, $value->[0], 2;
        $parsed_data->{default}{$dk} = $dv;
    }
    elsif ( $key eq 'code' ) {
        die "Error line $line_nb: Cannot mix code and load section\n" if $parsed_data->{load}->@*;
        push $parsed_data->{code}->@*, $value->@*;
    }
    elsif ( $key eq 'doc' ) {
        push $parsed_data->{doc}->@*, $value->@*;
    }
    elsif ( $key eq 'load' ) {
        die "Error line $line_nb: Cannot mix code and load section\n" if $parsed_data->{code}->@*;
        push $parsed_data->{load}->@*, $value->@*;
    }
    elsif ( $key eq 'commit' ) {
        $parsed_data->{commit_msg} = join "\n", $value->@*;
    }
    else {
        return 0;
    }
    return 1;
}

sub process_script_vars ($user_args, $data) {
    # $var is used in eval'ed strings
    my %var;

    # find if all variables are accounted for
    $data->{missing} = {};

    # %args can be used in var section of a script. A new entry in
    # added in %missing if the script tries to read an undefined value
    tie my %args, 'App::Cme::Run::Var',$data->{missing}, $data->{default};
    %args = $user_args->%*;

    my $var = delete $data->{var} // [];
    foreach my $eval_data ($var->@*) {
        my ($line_nb, @value);
        if (ref $eval_data) {
            # coming from text format
            ($line_nb, @value) = $eval_data->@*;
            # eval'ed string comes from system file, not from user data
            my $res = eval ("@value") ; ## no critic (ProhibitStringyEval)
            die "Error in var specification line $line_nb: $@\n" if $@;
        }
        else {
            # coming from YAML format
            my $res = eval ($eval_data) ; ## no critic (ProhibitStringyEval)
            die "Error in var specification: $@\n" if $@;
        }
    }

    replace_vars($user_args, \%var, $data, 'doc', 'load', 'commit_msg');

    $data->{values} = {$data->{default}->%*, %var, $user_args->%*};

    return $data;
}

sub parse_script ($script, $content, $user_args) {
    my $lines->@* =  split /\n/,$content;

    if ($lines->[0] =~ /Format:\s*perl/i) {
        ## no critic (ProhibitStringyEval)
        my $data = eval($content);
        die "Error in script $script (Perl format): $@\n" if $@;
        foreach my $forbidden (qw/load var default/) {
            die "Unexpected '$forbidden\ section in Perl format script $script\n" if $data->{$forbidden};
        }
        die "Unexpected 'code' section in Perl format script $script. Please use a sub section.\n" if $data->{code};
        return $data;
    }

    my $data;
    if ($lines->[0] =~ /Format:\s*yaml/i) {
        my $ypp = YAML::PP->new;
        $data = $ypp->load_string($content);
        foreach my $key (qw/doc code load var/) {
            next unless defined $data->{$key};
            next if ref $data->{$key} eq 'ARRAY';
            $data->{$key} = [ $data->{$key} ]
        }
        $data->{default} //= {};
        $data->{commit_msg} = delete $data->{commit};
        if ($data->{default} and ref $data->{default} ne 'HASH') {
            die "default spec must be a hash ref, not a ", ref $data->{default} // 'scalar', "\n";
        }
    }
    else {
        $data = parse_script_lines ($script, $lines);
    }

    my $processed_data = process_script_vars ($user_args, $data);

    if (not $processed_data->{app}) {
        die "Missing 'app' parameter in script $script.\n"
    }

    return $processed_data;
}

sub commit ($self, $root, $msg) {
    $msg =~ s/\{\{(.*?)\}\}/$root->grab_value($1)/e;

    system(qw/git commit -a -m/, $msg) == 0
        or die "git commit failed: $?\n";

    return;
}

# returns: script file name, script data if script is *not* Perl code
sub get_script_data ($self, $script_name, $opt = {}) {
    my $script_file = $self->find_script_file($script_name);

    my $content = $script_file->slurp_utf8;

    if ($content =~ m/^#!/ and -x $script_file) {
        return $script_file, {};
    }

    # parse variables passed on command line
    my %user_args = map { split '=',$_,2; } @{ $opt->{arg} };

    return ($script_file, parse_script($script_file, $content, \%user_args));
}

sub run_script_as_code ($self, $script_name, $script_file) {
    splice @ARGV, 0,2;          # remove 'run script' arguments
    my $done = eval $script_file->slurp_utf8."\n1;\n"; ## no critic (BuiltinFunctions::ProhibitStringyEval)
    if (ref $done eq 'HASH') {
        warn "script $script_name returns a hash but it's processed as a plain script.",
            " This may not be what you want\n";
    }
    die "Error in script $script_name: $@\n" unless $done;
    return;
}

sub execute {
    my ($self, $opt, $app_args) = @_;

    # cannot use logger until Config::Model is initialised

    # see Debian #839593 and perlunicook(1) section X 13
    @$app_args = map { decode_utf8($_, 1) } @$app_args;

    my $script_name = shift @$app_args;

    return unless $self->check_script_arguments($opt, $script_name);

    my ($script_file, $script_data) = $self->get_script_data($script_name, $opt);

    if ($opt->{cat}) {
        print $script_file->slurp_utf8;
        return;
    }

    if (not defined $script_data->{app}) {
        $self->run_script_as_code ($script_name, $script_file);
        return;
    }

    my $commit_msg = $script_data->{commit_msg};

    if ($opt->doc) {
        say join "\n", $script_data->{doc}->@*;
        say "will commit with message: '$commit_msg'" if $commit_msg;
        return;
    }

    if (my @missing = sort keys $script_data->{missing}->%*) {
        die "Error: Missing variables '". join("', '",@missing)
            ."' in command arguments for script $script_file\n"
            ."Please use option '".join(' ', map { "-arg $_=xxx"} @missing)."'\n";
    }

    $self->process_args($opt, [ $script_data->{app}, $app_args->@* ]);

    # override commit message. may also trigger a commit even if none
    # is specified in script
    if ($opt->{commit}) {
        $commit_msg = $opt->{commit};
    }

    $opt->{_verbose} = 'Loader' if $opt->{verbose};

    my ( $categories, $appli_info, $appli_map ) = Config::Model::Lister::available_models;
    my $app = $script_data->{app};
    if ($opt->{foreach} and $appli_info->{$app}{_category} ne 'application') {
        die "Cannot use --foreach option with $app. This option can only be used with ".
            join(' ', $categories->{application}->@*). ". Check your cme script.\n";
    }

    # parse variables passed on command line

    if ($opt->{foreach}) {
        $self->run_foreach_loop($opt,$app_args, $script_data);
    }
    else {
        my %user_args = map { split '=',$_,2; } @{ $opt->{arg} };
        $self->run_script ($opt, $app_args, $script_data, \%user_args);
    }

    return;
}

sub run_foreach_loop($self, $opt,$app_args, $script_data ) {
    my %user_args = map { split '=',$_,2; } @{ $opt->{arg} };

    my @dirs = map { chomp ; split /\s+/; }
        ($opt->{foreach} eq '-' ? <STDIN> : ($opt->{foreach}));

    my $start = path('.')->absolute;

    foreach my $d (@dirs) {
        my $t_dir = $start->child($d);
        if (not $t_dir->is_dir) {
            die "Cannot run script in $d: not a directory\n";
        }
        say "Running script in $t_dir ...";
        # instance is stored in Config::Model, so the name must be changed
        $opt->{instance_name} = $d;
        # instance is persisted in $self, so its ref must be removed
        delete $self->{_instance};
        chdir $t_dir->stringify;
        $self->run_script ($opt, $app_args, $script_data, {%user_args});
        # once we're done, remove instance from Model to avoid memory leaks
        # TODO: use delete_instance method provided by Config::Model from version 2.156
        delete $self->{_model}{instances}{$d};
    }

    chdir $start->stringify;
    return;
}

sub run_script ($self, $opt, $app_args, $script_data, $user_args){
    my $commit_msg = $script_data->{commit_msg};
    my $stashed;

    # check if workspace and index are clean
    if ($commit_msg and not $opt->{no_commit}) {
        ## no critic(InputOutput::ProhibitBacktickOperators)
        my $r = `git status --porcelain --untracked-files=no`;
        if ($?) {
            die "git status command failed: $?\n";
        }
        if ($r) {
            system(qw/git stash push --quiet --message/, "cme run auto stash") == 0
                or die "git stash push failed: $?\n";
            $stashed = 1;
        };
    }

    # call loads
    my ($model, $inst, $root) = $self->init_cme($opt,$app_args);
    foreach my $load_str ($script_data->{load}->@*) {
        $root->load($load_str);
    }

    if ($script_data->{code}) {
        my $to_run = '';
        while (my ($name, $value) = each $script_data->{values}->%*) {
            $to_run .= "my \$$name = '$value';\n";
        }
        $to_run .= join("\n",$script_data->{code}->@*);
        my $res = eval($to_run); ## no critic (ProhibitStringyEval)
        die "Error in code specification: $@\ncode is: \n$to_run\n" if $@;
    }

    if ($script_data->{sub}) {
        $script_data->{sub}->($root, $user_args);
    }

    if ($inst->needs_save) {
        $self->save($inst,$opt) ;

        # commit if needed
        if ($commit_msg and not $opt->{no_commit}) {
            $self->commit($root, $commit_msg);
        }
    } else {
        say "No change were applied";
    }


    if ($stashed) {
        system(qw/git stash pop --quiet/) == 0
            or die "git stash pop failed: $?\n";
    }

    return;
}

package App::Cme::Run::Var; ## no critic (Modules::ProhibitMultiplePackages)

require Tie::Hash;

## no critic (ClassHierarchies::ProhibitExplicitISA)
our @ISA = qw(Tie::ExtraHash);

sub FETCH {
    my ($self, $key) = @_ ;
    my ($h, $missing, $default) = @$self;
    my $res = $h->{$key} // $default->{$key} ;
    $missing->{$key} = 1 unless defined $res;
    return $res // '';
}

1;

__END__

=head1 SYNOPSIS

 $ cat ~/.cme/scripts/remove-mia
 doc: remove mia from Uploaders. Require mia parameter
 # declare app to configure
 app: dpkg
 # specify one or more instructions
 load: ! control source Uploaders:-~/$mia$/
 # commit the modifications with a message (git only)
 commit: remove MIA dev $mia

 $ cme run remove-mia -arg mia=longgone@d3bian.org

 # cme run can also use environment variables
 $ cat ~/.cme/scripts/add-me-to-uploaders
 app: dpkg-control
 load: source Uploaders:.push("$DEBFULLNAME <$DEBEMAIL>")

 $ cme run add-me-to-uploaders
 Reading package lists... Done
 Building dependency tree
 Reading state information... Done
 Changes applied to dpkg-control configuration:
 - source Uploaders:3: '<undef>' -> 'Dominique Dumont <dod@debian.org>'

 # show the script documentation
 $ cme run remove-mia -doc
 remove mia from Uploaders. require mia parameter

 # list scripts
 $ cme run -list
 Available scripts:
 - update-copyright
 - add-me-to-uploaders

 # mass modification
 $ cme run add-me-to-uploaders --foreach "raku-log raku-zef"
 # similar result
 $ echo "raku-*" | cme run add-me-to-uploaders --foreach -

=head1 DESCRIPTION

Run a script written for C<cme>

A script passed by name is searched in C<~/.cme/scripts>,
C</etc/cme/scripts> or C</usr/share/perl5/Config/Model/scripts>.
E.g. with C<cme run foo>, C<cme> loads either C<~/.cme/scripts/foo>,
C</etc/cme/scripts/foo> or
C</usr/share/perl5/Config/Model/scripts/foo>

No search is done if the script is passed with a path
(e.g. C<cme run ./foo>)

C<cme run> accepts scripts written with different syntaxes:

=over

=item cme DSL

For simple script, this DSL text specifies the target app, the doc,
optional variables and a load string used by L<Config::Model::Loader> or
Perl code.

=item YAML

Like text above, but using Yaml syntax.

=item Perl data structure

Writing Perl code in a text file or in a YAML field can be painful as
Perl syntax is not highlighted. With a Perl data structure, a cme
script specifies the target app, the doc, optional variables, and a
perl subroutine (see below).

=item plain Perl script

C<cme run> can also run plain Perl script. This is syntactic sugar to
avoid polluting global namespace, i.e. there's no need to store a
script using L<cme function|Config::Model/cme> in C</usr/local/bin/>.
Note that the script must begin with the usual shebang line (C<#!>)
and be executable.

=back


When run, this script:

=over

=item *

opens the configuration file of C<app>

=item *

applies the modifications specified with C<load> instructions or the Perl code.

=item *

save the configuration files

=item *

commits the result if C<commit> is specified (either in script or on command line).

=back

See L<App::Cme::Command::run> for details.

=head1 Syntax of text format

The script accepts instructions in the form:

 key: value

The key line can be repeated when needed.

Multi line values can also be:

 --- key
 multi line value
 ---

The script accepts the following instructions:

=over

=item app

Specify the target application. Must be one of the application listed
by C<cme list> command. Mandatory. Only one C<app> instruction is
allowed.

=item default

Specify default values that can be used in C<load> or C<var> sections.

For instance:

 default: name=foobar

=item var

Use Perl code to specify variables usable in this script. The Perl
code must store data in C<%var> hash. For instance:

    var: my @l = localtime; $var{year} =  $l[5]+1900;

The hash C<%args> contains the variables passed with the C<-arg>
option. Reading a value from C<%args> which is not set by user
triggers a missing option error. Use C<exists> if you need to test if
a argument was set by user:

    var: $var{foo} = exists $var{bar} ? $var{bar} : 'default' # good
    var: $var{foo} = $var{bar} || 'default' # triggers a "missing arg" error

=item load

Specify the modifications to apply using a string as specified in
L<Config::Model::Loader>. This string can contain variable
(e.g. C<$foo>) which are replaced by command argument (e.g. C<-arg
foo=bar>) or by a variable set in var: line (e.g. C<$var{foo}> as set
above) or by an environment variable (e.g. C<$ENV{foo}>)

=item code

Specify Perl code to run. See L</code section> for details.

=item commit

Specify that the change must be committed with the passed commit
message. When this option is used, C<cme> stashes and restores all
modifications if used on a non-clean workspace. This option works only
with L<git>.

Strings like C<{{ load path }}> are substituted with a value extracted
from configuration tree with the specified load path. See
L<Config::Model::Loader> for a valid load path.

For example, this specification:

    load: source Standards-Version="4.7.0"
    commit: declare compliance with policy {{source Standards-Version}}

yields this commit message:

    declare compliance with policy 4.7.0

=back

All instructions can use variables like C<$stuff> whose value can be
specified with C<-arg> options, with a Perl variable (from C<var:>
section explained above) or with an environment variable:

For instance:

  cme run -arg var1=foo -arg var2=bar

transforms the instruction:

  load: ! a=$var1 b=$var2

in

  load: ! a=foo b=bar

=head2 Example

Here's an example from L<libconfig-model-dpkg-perl scripts|https://salsa.debian.org/perl-team/modules/packages/libconfig-model-dpkg-perl/-/blob/master/lib/Config/Model/scripts/add-me-to-uploaders>:

  doc: add myself to Uploaders
  app: dpkg-control
  load: source Uploaders:.insort("$DEBFULLNAME <$DEBEMAIL>")
  commit: add $DEBEMAIL to Uploaders

=head2 Code section

The code section can contain variable (e.g. C<$foo>) which are replaced by
command argument (e.g. C<-arg foo=bar>) or by a variable set in var:
line (e.g. C<$var{foo}> as set above).

When evaluated the following variables are also set:

=over

=item $root

Root node of the configuration (See L<Config::Model::Node>)

=item $inst

Configuration instance (See L<Config::Model::Instance>)

=item $commit_msg

Message used to commit the modification.

=back

Since the code is run in an C<eval>, other variables are available
(like C<$self>) to shoot yourself in the foot.

For example:

 app:  popcon
 ---code
 $root->fetch_element('MY_HOSTID')->store($to_store);
 ---

=head1 Syntax of YAML format

This format is intented for people not wanting to user the text format
above. It supports the same parameters as the text format.

When using "!" and "$" characters in a string, using YAML block scalar
is probably easier.

For instance:

 # Format: YAML
 ---
 app: popcon
 default:
   defname: foobar
 var: |-
   $var{name} = $args{defname}
 load: |-
   ! MY_HOSTID=$name

=head1 Syntax of Perl format

This format is intended for more complex script where using C<load>
instructions is not enough.

This script must then begin with C<# Format: perl> and specifies a
hash. For instance:

 # Format: perl
 {
      app => 'popcon', # mandatory
      doc => "Use --arg to_store=a_value to store a_value in MY_HOSTID',
      commit => "control: update Vcs-Browser and Vcs-Git"
      sub => sub ($root, $arg) { $root->fetch_element('MY_HOSTID')->store($arg->{to_store}); }
 }

C<$root> is the root if the configuration tree (See L<Config::Model::Node>).
C<$arg> is a hash containing the arguments passed to C<cme run> with C<-arg> options.

The C<sub> parameter value must be a sub ref. Its parameters are
C<$root> (a L<Config::Model::Node> object containing the root of the
configuration tree) and C<$arg> (a hash ref containing the keys and
values passed to C<cme run> with C<--arg> options).

Note that this format does not support C<var>, C<default> and C<load>
parameters as you can easily achieve the same result with Perl code.

=head1 Options

=head2 list

List available scripts and exits.

=head2 arg

Arguments for the cme scripts which are used to substitute variables.

=head2 doc

Show the script documentation. (Note that C<--help> options show the
documentation of C<cme run> command)

=head2 cat

Pop the hood and show the content of the script.

=head2 commit

Like the commit instruction in script. Specify that the change must be
committed with the passed commit message.

=head2 no-commit

Don't commit to git (even if the above option is set)

=head2 foreach

Apply the script in specific directories. This option is available
only when dealing with application (See the list returned by C<cme list>).

For instance, if your directory contains several Debian packages and
you want to apply the same modification to all packages, you can run
something like:

   cme run add-me-to-uploaders --foreach "raku-log raku-zef"

or use C<STDIN> to send the package directories:

   ls "raku-*" | cme run add-me-to-uploaders --foreach -

=head2 verbose

Show effect of the modify instructions.

=head1 Common options

See L<cme/"Global Options">.

=head1 Examples

=head2 update copyright years in C<debian/copyright>

 $ cme run update-copyright -cat
 app: dpkg-copyright
 load: Files:~ Copyright=~"s/2016,?\s+$name/2017, $name/g"
 commit: updated copyright year of $name

 $ cme run update-copyright -arg "name=Dominique Dumont"
 cme: using Dpkg::Copyright model
 Changes applied to dpkg-copyright configuration:
 - Files:"*" Copyright: '2005-2016, Dominique Dumont <dod@debian.org>' -> '2005-2017, Dominique Dumont <dod@debian.org>'
 - Files:"lib/Dpkg/Copyright/Scanner.pm" Copyright:
 @@ -1,2 +1,2 @@
 -2014-2016, Dominique Dumont <dod@debian.org>
 +2014-2017, Dominique Dumont <dod@debian.org>
   2005-2012, Jonas Smedegaard <dr@jones.dk>

 [master ac2e6410] updated copyright year of Dominique Dumont
  1 file changed, 2 insertions(+), 2 deletions(-)

=head2 update VcsGit in debian/control

 $ cme run set-vcs-git  -cat
 doc: update control Vcs-Browser and Vcs-git from git remote value
 doc: parameters: remote (default is origin)
 doc:
 doc: example:
 doc:  cme run set-vcs-git
 doc:  cme run set-vcs-git -arg remote=debian
 
 app: dpkg-control
 default: remote: origin
 
 var: chomp ( $var{url} = `git remote get-url $args{remote}` ) ;
 var: $var{url} =~ s!^git@!https://!;
 var: $var{url} =~ s!(https?://[\w.]+):!$1/!;
 var: $var{browser} = $var{url};
 var: $var{browser} =~ s/.git$//;
 
 load: ! source Vcs-Browser="$browser" Vcs-Git="$url"
 commit: control: update Vcs-Browser and Vcs-Git

This script can also be written using multi line instructions:

 $ cme run set-vcs-git  -cat
 --- doc
 update control Vcs-Browser and Vcs-git from git remote value
 parameters: remote (default is origin)
 
 example:
  cme run set-vcs-git
  cme run set-vcs-git -arg remote=debian
 ---
 
 app: dpkg-control
 default: remote: origin
 
 --- var
 chomp ( $var{url} = `git remote get-url $args{remote}` ) ;
 $var{url} =~ s!^git@!https://!;
 $var{url} =~ s!(https?://[\w.]+):!$1/!;
 $var{browser} = $var{url};
 $var{browser} =~ s/.git$//;
 ---
 
 load: ! source Vcs-Browser="$browser" Vcs-Git="$url"
 commit: control: update Vcs-Browser and Vcs-Git

=head2 personal scripts

You may create your own scripts in C<~/.cme/scripts>. Here's an example:

 $ cat ~/.cme/scripts/set-any-arch
 app: dpkg-control
 load: binary:~".*" Architecture=any

=head1 SEE ALSO

L<cme>

=cut