Skip to content

Instantly share code, notes, and snippets.

@hkoba
Last active September 29, 2021 02:11
Show Gist options
  • Save hkoba/4b1f3c6b99dc98851b95a6ccf9cc096f to your computer and use it in GitHub Desktop.
Save hkoba/4b1f3c6b99dc98851b95a6ccf9cc096f to your computer and use it in GitHub Desktop.
This program represents my typical coding style in Perl, which widely relies on Modulino, fields, and custom type builder. (Note: this code has some known bugs.
#!/usr/bin/env perl
package DBQuery;
use strict;
# use File::AddInc;
use MOP4Import::Base::CLI_JSON -as_base
, [fields =>
[dbi => doc => "DBI spec"],
[dbi_attr => doc => "DBI connection attributes"],
qw(db_user db_password
_DB)
];
use DBI;
use SQL::Concat qw(SQL CAT);
sub DB {
(my MY $self) = @_;
$self->{_DB} //= do {
$self->{dbi} or Carp::croak "dbi option is empty!";
DBI->connect(
$self->{dbi}, $self->{db_user}, $self->{db_password}, {
PrintError => 0, RaiseError => 1, AutoCommit => 1,
MOP4Import::Util::lexpand($self->{dbi_attr}),
}
)
};
}
sub single {
(my MY $self, my $tabName, my @args) = @_;
my $where = @args >= 2 ? +{@args} : $args[0];
$self->query(SQL(qq(select * from $tabName), $self->where($where)))
}
sub where {
(my MY $self, my $where) = @_;
return unless $where;
SQL(
where =>
CAT("AND", map {["$_ = ?", $where->{$_}]} keys %$where)
)
}
sub query {
(my MY $self, my ($sql, @bind)) = @_;
my @fetchOption;
if (ref $sql eq 'ARRAY') {
# To change fetchOption, use like this:
# $self->query(["select id from t" => "fetchrow_array"], @bind)
#
($sql, @fetchOption) = @$sql;
}
elsif (ref $sql and UNIVERSAL::can($sql, "as_sql_bind")) {
if (@bind) {
Carp::croak "Don't mix SQL::Concat and raw bind parameters!";
}
($sql, @bind) = $sql->as_sql_bind;
}
$self->prepare($sql, @fetchOption)->(@bind);
}
sub prepare {
(my MY $self, my ($sql, $fetchMethod)) = @_;
$fetchMethod ||= 'fetchrow_hashref';
my $sth = $self->DB->prepare($sql);
return sub {
my (@bind) = @_;
$sth->execute(@bind)
or die $sth->errstr;
if (wantarray) {
my @result;
# fetchrow_hashref とかを listcontext で呼ぶと無限ループに陥るので
# ref 系は scalarcontext になるよう分けておく
if ($fetchMethod =~ /ref$/) {
while (my $row = $sth->$fetchMethod) {
push @result, $row;
}
} else {
while (my @res = $sth->$fetchMethod) {
push @result, @res;
}
}
@result;
} else {
$sth->fetchrow_hashref;
}
}
}
MY->cli_run(\@ARGV) unless caller;
1;
#!/usr/bin/env perl
package GiteaQuery;
use strict;
use utf8;
use File::AddInc;
use DBQuery -as_base
, [fields =>
[dbname => doc => "gitea database filename", default => "/data/sites/gitea/data/gitea.db"],
[gitrepo_base => default => "/home/git/gitea-repositories/"],
[gitea_url => default => 'https://example.com/'],
qw(_cache)
];
use Time::Piece;
use Digest::SHA1 qw(sha1_hex);
use GiteaTypes qw(Comment Issue Repository User Review);
use GitLabTypes qw(GL_Note GL_Position GL_Project);
use SQL::Concat qw(SQL CAT);
use MOP4Import::Types
(GitCommit => [[fields => qw(tree author committer parent)]]);
sub after_configure_default {
(my MY $self) = @_;
$self->maybe::next::method;
$self->{dbi} //= "dbi:SQLite:dbname=$self->{dbname}";
push @{$self->{dbi_attr}}, sqlite_unicode => 1;
}
sub cached_single_by_id {
(my MY $self, my ($table, $id)) = @_;
unless (defined $id and $id ne '') {
Carp::croak "id is empty for $table query!";
}
$self->{_cache}{$table,$id} //= $self->single($table, {id => $id});
}
#========================================
sub cmd_export_review_comment : Doc(export ruby script: review) {
(my MY $self, my @reviewList) = @_;
local (my $dbh = $self->DB)->{AutoCommit};
foreach my $reviewSpec (@reviewList) {
my $reviewId = do {
if (ref $reviewSpec) {
my Review $review = $reviewSpec;
# comment が有るのは review.type==2のみ
next unless $review->{type} == 2;
$review->{id};
}
elsif ($reviewSpec =~ /^\d+\z/) {
$reviewSpec
}
else {
Carp::croak "Invalid review spec: $reviewSpec"
}
};
my ($first, @rest) = $self->list_comment_id_by_review_id($reviewId) or do {
warn "# No comment for review $reviewId\n";
next
};
print "#-----------\n";
my $varName = "review$reviewId";
print qq{$varName = }, $self->rails_comment($first), "\n\n";
foreach my $id (@rest) {
print $self->rails_comment($id, "discussion_id: $varName.discussion_id"), "\n\n";
}
print "\n\n";
}
}
# CommentTypeCode == 21
sub list_comment_id_by_review_id : Doc(code review に属するコメントの id リスト) {
(my MY $self, my $reviewId) = @_;
unless (defined $reviewId and $reviewId) {
Carp::croak "reviewId is empty";
}
$self->prepare(q(select id from comment where review_id = ? and type = 21)
, 'fetchrow_array')
->($reviewId);
}
sub list_review_by_repo : Doc(team/project に属する review のレコード一覧) {
(my MY $self, my $repoSpec, my @rest) = @_;
local (my $dbh = $self->DB)->{AutoCommit};
my Repository $repo = do {
ref $repoSpec ? $repoSpec
: ($self->repository_by_owner_lower_name($repoSpec)
or Carp::croak "Unknown repo: $repoSpec")
};
$self->query(SQL(
[<<END, $repo->{id}]
select * from review
where issue_id in (
select id from issue where repo_id in (
select id from repository where id = ?
)
)
END
, (@rest ? ("AND", SQL(@rest)) : ())
));
}
sub repository_by_owner_lower_name : Doc(team/project の Repository レコード) {
(my MY $self, my $owner_lower_name) = @_;
local (my $dbh = $self->DB)->{AutoCommit};
my ($owner, $lower_name) = split m{/}, $owner_lower_name;
$self->query(<<END, $owner, $lower_name);
select * from repository where owner_id = (
select id from user where name = ?
) and lower_name = ?
END
}
sub rails_comment : Doc(ruby script:gitea comment に対応する gitlab note) {
(my MY $self, my ($id, @moreParams)) = @_;
my GL_Note $note = $self->get_gl_note_of_comment($id);
# Note.create() か、Notes::CreateService.new か…
my @expr;
push @expr, "position: ".sprintf(
q{Gitlab::Diff::Position.new(%s)}
, join ', ', $self->ruby_object_args(my GL_Position $pos = delete $note->{position})
);
push @expr, "original_position: ".sprintf(
q{Gitlab::Diff::Position.new(%s)}
, join ', ', $self->ruby_object_args(my GL_Position $org_pos = delete $note->{original_position} || $pos)
);
sprintf q{Note.create(%s)}, join ", "
, q(importing: true)
, q(noteable_type: "Commit")
, "author: ".sprintf(q{(User.find_by_email '%s')}
, delete $note->{author})
, "project: ".sprintf(q{(Project.find_by_full_path '%s')}
, delete $note->{project})
, @expr
, $self->ruby_object_args($note)
, @moreParams
;
}
sub get_gl_note_of_comment : Doc(gitea の comment を取得し gitlab note レコードへ変換) {
(my MY $self, my $id) = @_;
local (my $dbh = $self->DB)->{AutoCommit};
my Comment $comment = $self->cached_single_by_id(comment => $id)
or Carp::croak "No such comment (id=$id)";
my Issue $issue = $self->cached_single_by_id(issue => $comment->{issue_id})
or Carp::croak "No such issue (issue_id=$comment->{issue_id})";
my Repository $repo = $self->cached_single_by_id(repository => $issue->{repo_id})
or Carp::croak "No such repository (repo_id=$issue->{repo_id})";
my User $poster = $self->cached_single_by_id(user => $comment->{poster_id})
or Carp::croak "No such user (poster_id=$comment->{poster_id})";
(my GitCommit $cmmt) = @{$self->parse_repo_commit($repo, $comment->{commit_sha})}
or Carp::croak "No such git commit: $comment->{commit_sha}";
my GL_Note $note = {};
$note->{type} = 'DiffNote'; # XXX
$note->{note} = $comment->{content};
$note->{created_at} = gmtime($comment->{created_unix})->datetime . 'Z';
$note->{updated_at} = gmtime($comment->{updated_unix})->datetime . 'Z';
$note->{commit_id} = $comment->{commit_sha};
# gitlab 側で id を取り出すためのキーになりそうな情報を詰めておく。
# これを rails 側で Project.find_by_full_path, User.find_by_email する
$note->{project} = "$repo->{owner_name}/$repo->{lower_name}";
$note->{author} = $poster->{email};
my GL_Position $position = {};
$position->{head_sha} = $note->{commit_id};
$position->{base_sha} = $position->{start_sha}
= (ref $cmmt->{parent} ? $cmmt->{parent}[0]: $cmmt->{parent});
$position->{old_path} = $position->{new_path} = $comment->{tree_path};
$position->{new_line} = $comment->{line};
$position->{position_type} = 'text';
# $position->{line_range}
$note->{position} = $position;
$note->{line_code} = $self->line_code(
$comment->{tree_path}, $position->{new_line}, $position->{old_line}
);
$note;
}
# ./GiteaQuery.pm parse_repo_commit '{"owner_name":"hkoba","lower_name":"myproject"}' 11cb407a567dc9b475128c42852487089daf01d3|jq .
sub parse_repo_commit {
(my MY $self, my Repository $repo, my $commit_id) = @_;
my $text = $self->git_cat_file(
"$self->{gitrepo_base}/$repo->{owner_name}/$repo->{lower_name}.git",
$commit_id
);
my ($header, $body) = split /\n\n/, $text, 2;
my %header;
foreach my $line (split /\n/, $header) {
my ($key, $value) = split " ", $line, 2;
if (not defined $header{$key}) {
$header{$key} = $value;
} elsif (not ref $header{$key}) {
$header{$key} = [$header{$key}, $value]
} else {
push @{$header{$key}}, $value;
}
}
[\%header, $body]
}
#========================================
sub cmd_export_repository : Doc(export ruby script: repository) {
(my MY $self, my @repoList) = @_;
local (my $dbh = $self->DB)->{AutoCommit};
foreach my $repoSpec (@repoList) {
my Repository $repo = do {
ref $repoSpec ? $repoSpec
: ($self->repository_by_owner_lower_name($repoSpec)
or Carp::croak "Unknown repo: $repoSpec")
};
my GL_Project $prj = $self->get_gl_project_of_repo($repo);
printf <<'END', $prj->{namespace}, $prj->{name}, $self->ruby_quote($prj->{description});
owner = User.find_by_name('%s')
::Projects::CreateService.new(owner, {
name: '%s', namespace_id: owner.namespace_id,
description: '%s'
}).execute
END
;
# ここで issue も追加するのが良さそうに思えるが…
}
}
sub get_gl_project_of_repo : Doc(gitea の repository を gitlab project レコードへ変換) {
(my MY $self, my Repository $repo) = @_;
my GL_Project $project = {};
# XXX: name に使えない文字があるはず。変換を
$project->{name} = $repo->{lower_name};
$project->{description} = $repo->{description};
$project->{namespace} = $repo->{owner_name};
$project;
}
sub list_user_repository_name : Doc(ユーザーの持つrepository の一覧 ){
(my MY $self, my $user) = @_;
map {
my Repository $repo = $_;
"$repo->{owner_name}/$repo->{lower_name}"
} $self->list_user_repository($user)
}
sub list_user_repository : Doc(ユーザーの持つrepository のレコード一覧) {
(my MY $self, my $user) = @_;
unless (defined $user and $user ne '') {
Carp::croak "username is required!";
}
local (my $dbh = $self->DB)->{AutoCommit};
$self->query(q{select * from repository where owner_id = (select id from user where name = ?) order by lower_name}, $user)
}
#========================================
sub list_issue_from_repository : Doc(repository の issue レコード一覧) {
(my MY $self, my $repoSpec) = @_;
local (my $dbh = $self->DB)->{AutoCommit};
my Repository $repo = do {
ref $repoSpec ? $repoSpec
: ($self->repository_by_owner_lower_name($repoSpec)
or Carp::croak "Unknown repo: $repoSpec")
};
$self->query(q{select * from issue where repo_id = ?}, $repo->{id})
}
#========================================
sub cmd_generate_repo_importer {
(my MY $self, my @repoList) = @_;
local (my $dbh = $self->DB)->{AutoCommit};
printf <<'END', $self->ruby_value($self->{gitea_url});
apikey = (STDIN.getpass 'Enter Gitea API Key: ')
clnt = Gitlab::LegacyGithubImport::Client.new(apikey, {host: %s, api_version: 'v1'})
root = User.find(1)
END
foreach my $repoSpec (@repoList) {
my Repository $repo = do {
ref $repoSpec ? $repoSpec
: ($self->repository_by_owner_lower_name($repoSpec)
or Carp::croak "Unknown repo: $repoSpec")
};
my User $owner = $self->cached_single_by_id(user => $repo->{owner_id});
printf <<'END'
Import::GithubService.new(clnt, root, {
repo_id: %d, target_namespace: %s, new_name: %s,
}).execute({ github_access_token: apikey }, :gitea)
END
, $repo->{id}, $self->ruby_value($owner->{name})
, $self->ruby_value($self->gitlab_project_name_from_gitea_repo_name($repo->{lower_name}));
# ここで review comment を投入する
if (my @review = $self->list_review_by_repo($repo)) {
# review 投入前に、import が完了しているか確認
print <<'END';
print 'Waiting ProjectImportData become empty...'
while ProjectImportData.all.size > 0
print '.'
sleep 5
end
print "\n"
END
;
$self->cmd_export_review_comment(@review);
}
print "\n";
}
}
sub gitlab_project_name_from_gitea_repo_name : Doc(gitea の repository 名を gitlab 用に変換) {
(my MY $self, my $oldName) = @_;
lc($oldName =~ s/[-.]/_/gr);
}
#========================================
sub git_cat_file {
(my MY $self, my ($dir, $commit)) = @_;
open my $pipe, "-|:encoding(utf-8)",
'git', "--git-dir=$dir", 'cat-file', '-p', $commit
or Carp::croak "Can't run git cat-file";
chomp(my $text = do {local $/; <$pipe>});
$text;
}
sub line_code {
(my MY $self, my ($file_path, $new_line, $old_line)) = @_;
$old_line //= 0;
join '_' => sha1_hex($file_path), $old_line, $new_line;
}
sub ruby_quote {
(my MY $self, my $str) = @_;
$str =~ s/[\\\']/\\$&/gr;
}
sub ruby_value {
(my MY $self, my $strOrNum) = @_;
if (not defined $strOrNum) {
return 'nil'
} elsif ($strOrNum =~ /^\d+\z/) {
return $strOrNum
} else {
return "'".$self->ruby_quote($strOrNum)."'";
}
}
sub ruby_object_args {
(my MY $self, my $object) = @_;
map {
my $value = $self->ruby_value($object->{$_});
"$_: $value"
} keys %$object
}
MY->cli_run(\@ARGV) unless caller;
1;
package GiteaTypes;
use strict;
use MOP4Import::Declare -as_base; # To define 'sub import'
# ./GiteaQuery.pm query "pragma table_info('repository')"| jq --raw-output '.name'
use MOP4Import::Types
(
Comment => [[fields => qw(
id
type
poster_id
original_author
original_author_id
issue_id
label_id
old_milestone_id
milestone_id
assignee_id
removed_assignee
resolve_doer_id
old_title
new_title
old_ref
new_ref
dependent_issue_id
commit_id
line
tree_path
content
patch
created_unix
updated_unix
commit_sha
review_id
invalidated
ref_repo_id
ref_issue_id
ref_comment_id
ref_action
ref_is_pull
)]],
Issue => [[fields => qw(
id
repo_id
index
poster_id
original_author
original_author_id
name
content
milestone_id
priority
is_closed
is_pull
num_comments
ref
deadline_unix
created_unix
updated_unix
closed_unix
is_locked
)]],
Repository => [[fields => qw(
id
owner_id
owner_name
lower_name
name
description
website
original_service_type
original_url
default_branch
num_watches
num_stars
num_forks
num_issues
num_closed_issues
num_pulls
num_closed_pulls
num_milestones
num_closed_milestones
is_private
is_empty
is_archived
is_mirror
status
is_fork
fork_id
is_template
template_id
size
is_fsck_enabled
close_issues_via_commit_in_any_branch
topics
avatar
created_unix
updated_unix
)]],
User => [[fields => qw(
id
lower_name
name
full_name
email
keep_email_private
email_notifications_preference
passwd
passwd_hash_algo
must_change_password
login_type
login_source
login_name
type
location
website
rands
salt
language
description
created_unix
updated_unix
last_login_unix
last_repo_visibility
max_repo_creation
is_active
is_admin
is_restricted
allow_git_hook
allow_import_local
allow_create_organization
prohibit_login
avatar
avatar_email
use_custom_avatar
num_followers
num_following
num_stars
num_repos
num_teams
num_members
visibility
repo_admin_change_team_access
diff_view_style
theme
)]],
Review => [[fields => qw(
id
type
reviewer_id
original_author
original_author_id
issue_id
content
official
commit_id
stale
created_unix
updated_unix
)]],
);
1;
package GitLabTypes;
use strict;
use MOP4Import::Declare -as_base; # To define 'sub import'
use MOP4Import::Types
(
GL_Note => [[fields => qw(
id
note
noteable_type
author_id author
created_at
updated_at
project_id project
attachment
line_code
commit_id
noteable_id
system
st_diff
updated_by_id
type
position
original_position
resolved_at
resolved_by_id
discussion
note_html
cached_markdown_version
change_position
resolved_by_push
review_id
confidential
last_edited_at
)]],
GL_Position => [[fields => qw(
base_sha
start_sha
head_sha
old_path
new_path
position_type
old_line
new_line
line_range
)]],
GL_Project => [[fields => qw(
name
description
namespace_id namespace
)]]
);
1;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment