#contents
*系統の遺伝子型から FlyBase へのリンクを作る perl プログラム 11 May 2010 [#z210d183]
ショウジョウバエ遺伝資源センターでは系統リスト
（http://kyotofly.kit.jp/stocks/）の遺伝子型から
FlyBase へリンクを張っています。
ですが、現在は遺伝子記号（gene symbol）に対してのみしかできていません。
そこで、もう少し「上手に」リンクを張るために遺伝子型から
リンクを作成するperlのサンプルプログラムを作成しました。
もう少ししたらこれと同じような仕様に変わるでしょう。
実運用に使われるかどうかはわかりません。
ま、とにかく動けばいいのです。
以下の perlスクリプトは、テスト用に html ファイルを stdout に出力します。
プログラムはあまり時間を掛けずに書いたので
（一晩でと言いたいところですが、もう少しかかってしまいました）、
ボロがあると思います。
今見ると直したい気になるが、ま、いっか((がしかし、今日、バグを見つけ修正。690行目 誤： $Lastparen → 正： $lastparen))((更に、修正 sub whichcateogry の中の 最後のif 文 12 May 2010))。
*** 2015年1月15日追加 [#t2655fdd]
URI unsafe な construct symbol がある場合、
そのままブラウザによる「% encoding」に任せると FlyBase で上手く検索ができない。
例えば、
P{w[+mW.Scer\FRT.hs3]=3'.RS5+3.3'}
を short construct の形
P{3'.RS5+3.3'}
にしただけではだめ。
これは FlyBase の仕様なのかと思って、
プログラムを直してくれるとうれしいと
FlyBase にコメントを送ったら（本日12時頃）、
速攻で（1時間後くらいに）エスケープが間違っちょる、と返事が来た
（すごいっ、Josh Goodman さん！）。
そこで、こちらも速攻で perl を作り直しました。
URI query に使う遺伝子記号などの symbol を uri_escape しただけ。
下のスクリプトでは
$temp .= uri_escape($mysymbol);
の部分（もう１行おまじないもあります）。エスケープ結果は、正しく
P%7B3%27.RS5%2B3.3%27%7D
となりました。
近く実装の予定。
**方針は下のとおり [#n58ce573]
***１．FlyBase へのリンク [#d9815850]
http://flybase.org/cgi-bin/uniq.html?species=Dmel&field=SYN&db=fb
# 上と下の間にgn、fb、tp、ti、ba、abを入れる
# fbgn 遺伝子記号
# fbtp 組換えトランスポゾン
# fbti 挿入
# fbba バランサー
# fbab 染色体異常
&caller=quicksearch&context=
# 最後にクエリー文字列をつなげて仕上げ
***２．クエリー文字列は例外を除き、下のようなものに [#b717787c]
- 遺伝子記号のときは、allele をカットする
- 挿入のときは、~
1) コンストラクトへのリンク~
2) 挿入そのもの（identifier含めて）へのリンク~
を作る
- コンストラトは「short」のタイプにする
（そうしないとFlyBaseは返さない）
- バランサーと染色体異常のときは、そのままリンクを作る
***３．遺伝子型から遺伝子記号、組換えコンストラクト、挿入、バランサー、染色体異常を判断する方法 [#t5382eea]
- 組換えコンストラクト recombinant construct → Fbtp~
{と}で囲まれているものの左側は空白まで、右側は}まで
- 挿入 insertion → Fbti~
{と}で囲まれているものの外側で空白の間
- バランサー：例示（ポジティブリスト）ではじまるもの balancer → Fbba~
(['^ClB', '^FM[0-9]', '^Basc', '^Binsc', '^Inscy', '^Binsinscy',
'^Binsn', '^CyO', '^SM[0-9]', '^TM[0-9]', '^MRS', '^MKRS', '^CxD',
'^DcxF', '^LVM', '^TMS']);
- 染色体異常 abberation → Fbab~
(を含み、例外以外
染色体異常ではない記号：例示（ポジティブリスト）ではじまるもの
(['a(', 'acd(', 'anon-F117(', 'anon-atl149(', 'c(', 'dil(', 'E(',
'e(', 'fl(', 'fms(', 'fs(', 'Fs(', 'gl(', 'gs(', 'GS(', 'ifm(',
'Ifm(', 'im(', 'l(', 'M(', 'MENE(', 'MNPV(', 'Mod(','mat(', 'm(',
'mcl(', 'mei(', 'mfs(', 'mit(', 'mod(', 'mor(', 'ms(', 'msd(',
'Mu(', 'NPV(', 'P(', 'PL(', 'r(', 'RD(', 'ref(', 'r(', 'rK(', 'rk(',
'Rst(', 's(', 'sens(', 'sl(', 'ss(', 'S(', 'Su(', 'su(', 'tu(',
'v(', 'Z(']);
# FlyBaseにある遺伝子記号を全てチェックした 25 April 2010
- 遺伝子記号 gene → Fbgn~
その他残り全て
ポジティブリスト方式は漏れが出やすいので避けたい。
その結果、わけのわからないものが遺伝子記号としてリンクされる可能性がある。
しかし、このような、
ポジティブリスト方式を取らずに自動でリンクを作る方法では解決策がない。
- allele → Fbal（リンクは作らない）~
[と]で囲まれているもの
***４．リンクの例外（ネガティブリスト） [#l2662653]
運用してみて、多少の修正が必要かも
- リンクしない記号 = (['^0', '^T\(', ',\b', ';']); # 正規表現
- リンクしない記号 = (['/', ';', ',', '+']); # 完全一致
- リンクしない末端の文字 = (['/', ';', ',', ':']);
***５．系統の遺伝子型を遺伝子記号等に分解する方法の修正 [#xa062521]
- 「{」と「}」の間の空白は遺伝子記号の区分けではない
- そのほかは空白を区切りとしてよい
***６．遺伝子型ではなく、「series」で判断して、リンク不要のもの((この perl スクリプトには含まれません。データ内容を知らないと意味不明と思います。FlyTrap は遺伝子型を正しく書き換えた後リンクするよう変更しました。W は野生型、nonmel はキイロショウジョウバエではない場合)) [#i0961408]
- 例示（ポジティブリスト）： W %%FlyTrap%% nonmel
**perl スクリプト [#sea458af]
コードは少しオブジェクト指向にしてしまいました。
こういう場合、構造化プログラミングよりも
オブジェクト指向プログラミングが適しているので。
とはいえ、perlでオブジェクト指向はほぼ初心者なので幼稚な感じのはず。
プログラムを学んだ時期の手法（ANSI C 2.0、ANSI C++策定直前）が
ぼくにとっては一番作り易いので、
「少し」という程度のオブジェクト指向
（構造体に関数が入っている程度のClass）です。
動作確認はウィンドウズ用のActivePerlのみで行いました。
［追記 16 May 2010］
#!perl
###############################################################
#
# genlink.pl
# 系統の遺伝子型から FlyBase へのリンクを作る perl プログラム
# Copyright (c) TOMARU Masatoshi 25 April 2010
#
# 動作テスト環境（perl -vの出力）
# ---------------------------------------------
# This is perl, v5.10.1 built for MSWin32-x64-multi-thread
# (with 2 registered patches, see perl -V for more detail)
#
# Copyright 1987-2009, Larry Wall
#
# Binary build 1007 [291969] provided by ActiveState http://www.ActiveState.com
# Built Jan 27 2010 14:12:21
#
# Perl may be copied only under the terms of either the Artistic License or the
# GNU General Public License, which may be found in the Perl 5 source kit.
#
# Complete documentation for Perl, including FAQ lists, should be found on
# this system using "man perl" or "perldoc perl". If you have access to the
# Internet, point your browser at http://www.perl.org/, the Perl Home Page.
# ---------------------------------------------
#
# 現時点で GPL（GNU General Public License）を宣言すると
# 困る人が出る可能性があるので著作権は主張しておきます 都丸雅敏
#
# このプログラムの作成にあたっては、文法書の類を参照しただけで
# ほかの人の作ったプログラムの流用はしていません
# なお、クラス化［オブジェクト指向化］部分はまねしたものがあります
# 具体的には、
# my $this = shift;
# こうするといい、とか
# bless $mystr, $this; ← コンストラクタの部分
# こうしないとインスタンスができない、とか
#
# FlyBase へのリンクは、現行のものを使いましたが
# これは著作権云々に当たらない部分なので問題なしと考えます
#
###############################################################
# 定数定義
#
# FlyBase へリンクするためのおまじない
$hypertext1 = "http://flybase.org/cgi-bin/uniq.html?species=Dmel&field=SYN&db=fb";
# 上と下の間にgn、fb、tp、ti、ba、abを入れる
# fbgn 遺伝子記号
# fbtp 組換えトランスポゾン
# fbti 挿入
# fbba バランサー
# fbab 染色体異常
$hypertext2 = "&caller=quicksearch&context=";
# 最後にクエリー文字列をつなげて仕上げ
# 染色体異常ではない記号
$nonabberation = (['a(', 'acd(', 'anon-F117(', 'anon-atl149(', 'c(',
'dil(', 'E(', 'e(', 'fl(', 'fms(', 'fs(', 'Fs(', 'gl(', 'gs(', 'GS(',
'ifm(', 'Ifm(', 'im(', 'l(', 'M(', 'MENE(', 'MNPV(', 'Mod(','mat(',
'm(', 'mcl(', 'mei(', 'mfs(', 'mit(', 'mod(', 'mor(', 'ms(', 'msd(',
'Mu(', 'NPV(', 'P(', 'PL(', 'r(', 'RD(', 'ref(', 'r(', 'rK(', 'rk(',
'Rst(', 's(', 'sens(', 'sl(', 'ss(', 'S(', 'Su(', 'su(', 'tu(', 'v(',
'Z(']);
# index で有無と位置を調べる
# 「(」を含む遺伝子記号
# FlyBaseにある遺伝子記号を全てチェックした 25 April 2010
# バランサー
$balancersymbols = (['^ClB', '^FM[0-9]', '^Basc', '^Binsc', '^Inscy',
'^Binsinscy', '^Binsn', '^CyO', '^SM[0-9]', '^TM[0-9]', '^MRS', '^MKRS',
'^CxD', '^DcxF', '^LVM', '^TMS']);
# 正規表現で利用
# とりあえず、こんなもんでしょう。 25 April 2010 時点でのある系統は網羅
# リンクしない記号
$nolinksymbols = (['^0', '^T\(', ',\b', ';']);
# 正規表現で利用
# リンクしない記号（完全一致する場合）
$nolinksymbols_perfect = (['/', ';', ',', '+']);
# eq で比較
# リンクしない末端の文字
$nolinksymbols_separater = (['/', ';', ',', ':']);
# eq で比較
###############################################################
#
# メインルーチンはテスト表示のためでしかない
#
###############################################################
package main;
print "<html>\n";
print "<title>Link to FlyBase</title>\n";
print "<body>\n";
print "<h3>Link to FlyBase</h3>\n";
print "<table>\n";
while(<>){
chop;
print "<tr>\n";
print "<td>Original:</td>\n<td>";
print;
print "\n</td></tr>\n";
print "<tr>\n";
print "<td>With Link:</td>\n<td>";
@mysymbols = genotypesplit($_);
$numsymbols = scalar(@mysymbols);
$presentsymbol = new MyString;
for( $mynum=0; $mynum<$numsymbols; $mynum++){
$presentsymbol->mytext($mysymbols[$mynum]);
$presentsymbol->printhypertext();
print " ";
}
print "</td></tr>\n";
print "<tr><td> </td></td>\n";
}
print "</table>\n";
print "</body>\n";
print "</html>\n";
# 系統の遺伝子型から遺伝子記号などに分解する
# これがミソでもあるが
# chopを使って作ったちょっと「せこい」感じのプログラム
sub genotypesplit{
my $mystring = $_[0]; # 可読性のためコピーする
my $mylength = length($mystring);
my $newstring = "";
my $mystatus = 0;
my @splitted = "";
for( $i=0; $i<$mylength; $i++){
$mychar = chop($mystring);
if($mychar eq '}'){
$mystatus = 1; # 中に入った！
}
if($mychar eq '{'){
$mystatus = 0; # 出た！
}
# 「{」と「}」の間の空白は遺伝子記号の区分けではない
if( ($mystatus == 1) && ($mychar eq ' ') ){
$mychar = '__MySpace__';
}
$newstring = $mychar . $newstring;
}
@splitted = split(/ /, $newstring);
$mylength = scalar(@splitted);
for( $i=0; $i<$mylength; $i++){
$splitted[$i] =~ s/__MySpace__/ /;
# 空白を戻す
}
return @splitted;
}
######################################################################
#
# 「Class」 定義ここから
#
######################################################################
# 遺伝子記号文字列を Class 化する
# C++ なら、String のような感じかも
# 使わない関数もあるがひととおり作っている
package MyString;
# uri_escape() を使うために呼び出す
# package MyString のスコープ内で使うためにはここで呼び出す
# 2015年1月13日追加
use URI::Escape;
# コンストラクタ
sub new{
my $this = shift;
my $mystr;
if( @_ ){
my $initMystr = shift;
$mystr = {
"mytext" => $initMystr->mytext(),
# 読み込んだ文字列
"category" => $initMystr->category(),
# FlyBaseのdbのカテゴリ
"ishyperlink" => $initMystr->ishyperlink(),
# ハイパーリンクを作るか否か
"withoutidentifier" => $initMystr->withoutidentifier(),
# 元々のコンストラクトで insertion identifier なし
"insertionidentifier" => $initMystr->insertionidentifier(),
# insertion identifier のみ
"shortconstrust" => $initMystr->shortconstrust(),
# recombinant construct の short expression
"shortinsertion" => $initMystr->shortinsertion(),
# insertion を recombinant construct の short expression で
"myhypertext" => $initMystr->myhypertext()
# ハイパーリンク付テキスト
};
}else{
# デフォルトの初期化
$mystr = {
"mytext" => "",
# デフォルトは読み込んだ行は空の文字列
"category" => "gn",
# FlyBaseのdbのカテゴリ
# fbgn 遺伝子記号 allleへリンクはしない：デフォルト
# fbtp 組換えトランスポゾン
# fbti 挿入 tpとともに使う
# fbba バランサー 判断のためにリストを利用
# fbab 染色体異常 判断のためにリストを利用
# FlyBaseが上手く返事を寄こさないものがあるので、NGリストも必要
"ishyperlink" => 1,
# ハイパーリンクを作るか否か：デフォルト作る
"withoutidentifier" => "",
# 元々のコンストラクトで insertion identifier なし
"insertionidentifier" => "",
# insertion identifier のみ
"shortconstrust" => "",
# recombinant construct の short expression
"shortinsertion" => "",
# insertion を recombinant construct の short expression で
"myhypertext" => "" # ハイパーリンク付テキスト
} ;
}
bless $mystr, $this;
return $mystr;
}
# デフォルトに初期化（newと一緒にできるほうがいいのだが……）
sub initialize{
my $this = shift;
$this->{mytext} = "";
# デフォルトは読み込んだ行は空の文字列
$this->{category} = "gn";
# FlyBaseのdbのカテゴリ
# fbgn 遺伝子記号 allleへリンクはしない：デフォルト
# fbtp 組換えトランスポゾン
# fbti 挿入 tpとともに使う
# fbba バランサー 判断のためにリストを利用
# fbab 染色体異常 判断のためにリストを利用
# FlyBaseが上手く返事を寄こさないものがあるので、NGリストも必要
$this->{ishyperlink} = 1;
# ハイパーリンクを作るか否か：デフォルト作る
$this->{withoutidentifier} = "";
# 元々のコンストラクトで insertion identifier なし
$this->{insertionidentifier} = "";
# insertion identifier のみ
$this->{shortconstrust} = "";
# recombinant construct の short expression
$this->{shortinsertion} = "";
# insertion を recombinant construct の short expression で
$this->{myhypertext} = ""; # ハイパーリンク付テキスト
}
# sub DESTROY{
# my $this = shift;
#
# print "DESTROY\n";
# }
sub copy{
my $this = shift;
if( @_ ){
my $mystr = shift;
$this->{mytext} => $mystr->mytext();
$this->{category} => $mystr->category();
$this->{ishyperlink} => $mystr->ishyperlink();
$this->{withoutidentifier} => $mystr->withoutidentifier();
$this->{insertionidentifier} => $mystr->insertionidentifier();
$this->{shortconstrust} => $mystr->shortconstrust();
$this->{shortinsertion} => $mystr->shortinsertion();
$this->{myhypertext} => $mystr->myhypertext();
}
return $this;
}
sub mytext{
my $this = shift;
# mytextが更新されたら、ほかの情報を初期化し処理し直す
$this->initialize();
if( @_ ){
$this->{mytext} = shift;
$this->generatehypertext();
}
return $this->{mytext};
}
sub category{
my $this = shift;
if( @_ ){
$this->{category} = shift;
}
return $this->{category};
}
sub ishyperlink{
my $this = shift;
if( @_ ){
$this->{ishyperlink} = shift;
}
return $this->{ishyperlink};
}
sub withoutidentifier{
my $this = shift;
if( @_ ){
$this->{withoutidentifier} = shift;
}
return $this->{withoutidentifier};
}
sub insertionidentifier{
my $this = shift;
if( @_ ){
$this->{insertionidentifier} = shift;
}
return $this->{insertionidentifier};
}
sub shortconstrust{
my $this = shift;
if( @_ ){
$this->{shortconstrust} = shift;
}
return $this->{shortconstrust};
}
sub shortinsertion{
my $this = shift;
if( @_ ){
$this->{shortinsertion} = shift;
}
return $this->{shortinsertion};
}
sub myhypertext{
my $this = shift;
if( @_ ){
$this->{myhypertext} = shift;
}
if( !length($this->{myhypertext}) ){
$this->generatehypertext();
}
return $this->{myhypertext};
}
sub printtext{
my $this = shift;
print $this->{mytext};
}
sub printhypertext{
my $this = shift;
# 一々動かすのは無駄だけど、一回ずつ作り直すことにする
# テストくらいしか使わないだろうし
if( !length($this->{myhypertext}) ){
$this->generatehypertext();
}
print $this->{myhypertext};
}
# ハイパーテキストを作る
# 遺伝子記号、挿入、バランサー、染色体異常で少しずつ異なる処理をする
sub generatehypertext{
my $this = shift;
$this->processmytext();
$this->{myhypertext} = ""; # 先にデータがあっても消す
if ( !($this->{ishyperlink}) ){
# ハイパーテキストを作らないときは、テキストをしまっておく
$this->{myhypertext} .= $this->{mytext};
} else {
$this->{myhypertext} .= "<a href=\"";
if( $this->{category} eq "gn"){
# 遺伝子記号のときは、allele をカットしてリンクを作る
$this->{myhypertext} .=
$this->makelink(
$this->dropallele( $this->{mytext} ),
$this->{category}
);
$this->{myhypertext} .= "\">";
$this->{myhypertext} .= $this->{mytext};
$this->{myhypertext} .= "</a>";
} elsif( $this->{category} eq 'tp'){
# 挿入のときは、
# １．コンストラクトへのリンク
# ２．挿入そのもの（identifier含めて）へのリンク
# を作る
# コンストラトは「short」のタイプにしないとFlyBaseは返さない
$this->{myhypertext} .=
$this->makelink(
$this->{shortconstrust},
$this->{category}
);
$this->{myhypertext} .= "\">";
$this->{myhypertext} .= $this->{withoutidentifier};
$this->{myhypertext} .= "</a>";
if( $this->{insertionidentifier} ){
# identifierがない場合、当然リンクは作らない
$this->{myhypertext} .= "<a href=\"";
$this->{myhypertext} .=
$this->makelink(
$this->{shortinsertion},
"ti"
);
$this->{myhypertext} .= "\">";
$this->{myhypertext} .= $this->{insertionidentifier};
$this->{myhypertext} .= "</a>";
}
} elsif( ($this->{category} eq "ba") ||
($this->{category} eq "ab") ) {
# バランサーと染色体異常のときは、そのままリンクを作る
$this->{myhypertext} .=
$this->makelink(
$this->{mytext},
$this->{category}
);
$this->{myhypertext} .= "\">";
$this->{myhypertext} .= $this->{mytext};
$this->{myhypertext} .= "</a>";
} else{
# その他は存在させないが原則だが、
# 念のため、リンクなしを作るようにしておく
$this->{myhypertext} = $this->{mytext};
# 意識してドットなしイコールにしているので注意
}
}
return $this->{myhypertext};
}
# sub generatehypertextで使うサブルーチン
sub processmytext{
my $this = shift;
$this->whichcateogry();
# $this->{category} = "gn";
# $this->{category} = "tp";
# $this->{category} = "ab";
# $this->{category} = "ba";
# $this->{ishyperlink} = 1;
# $this->{ishyperlink} = 0;
if($this->{category} eq "tp"){
# 挿入のときは、道具を作っておく
$this->{withoutidentifier} = $this->makeswithoutidentifier();
$this->{insertionidentifier} = $this->makesinsertionidentifier();
$this->{shortconstrust} = $this->makeshortconstruct();
$this->{shortinsertion} =
$this->{shortconstrust} . $this->{insertionidentifier};
}
}
# 記号の種類を判断する
sub whichcateogry{
my $this = shift;
if( (index($this->{mytext},'{') > 0) ){
# 「{」があれば挿入、要リンク
$this->{category} = "tp";
$this->{ishyperlink} = 1;
} elsif( $this->isbalancer($this->{mytext}) ){
# バランサー：指定しているもののみ
$this->{category} = "ba";
$this->{ishyperlink} = 1;
} elsif( $this->isnolink($this->{mytext}) ){
# リンク不要の記号
$this->{ishyperlink} = 0;
} elsif( $this->{ishyperlink} ) {
# デフォルトはリンク要
# 上で判断できなかったものは遺伝子記号としてリンクを作る
$this->{category} = "gn";
$this->{ishyperlink} = 1;
if( index($this->{mytext}, "(") > 0 ) {
# $this->{category} = "ab";
# # しかし、リンク可能な染色体異常もあるのでリンクを作る
# # 染色体異常は「(」を含むが
# # 「l(2)」などではない
# $listsymbolnumber = scalar(@{$main::nonabberation});
# for($my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
# if( index($this->{mytext},
# @{$main::nonabberation}[$my_i] ) >= 0 ){
# $this->{category} = "gn";
# しかし、リンク可能な染色体異常もあるのでリンクを作る
# 染色体異常は「(」を含むが
# 「l(2)」などではない
$listsymbolnumber = scalar(@{$main::nonabberation});
for($my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
if( index($this->{mytext},
@{$main::nonabberation}[$my_i] ) < 0 ){
$this->{category} = "ab";
}
}
}
# 結果として、わけのわからないものが遺伝子記号としてリンクされ
# る可能性がある
}
}
# バランサーか否かを判断する
sub isbalancer{
my $this = shift;
my $mysymbol = $_[0];
my $listsymbolnumber = scalar(@{$main::balancersymbols});
my $my_i = 0;
# m コマンド を使って、文字列が含まれるか否かを検査
# EXPR =~ m/RE/ ： EXPRがRE（正規表現で）
# 含まれると 1 を返すので if 内で正偽の判断ができる
for($my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
if( $mysymbol =~ m/@{$main::balancersymbols}[$my_i]/ ){
return 1;
}
}
return 0;
}
# リンク不要かどうか判断する
# 注意！不要なら「1」を返す
sub isnolink{
my $this = shift;
my $mysymbol = $_[0]; # 可読性のため
my $listsymbolnumber = 0;
my $my_i = 0;
# 全くリンクしないもの
$listsymbolnumber = scalar(@{$main::nolinksymbols_perfect});
for($my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
if( $mysymbol eq @{$main::nolinksymbols_perfect}[$my_i] ){
return 1;
}
}
# 正規表現で検査する前に、
# 最後のひと文字がコンマなどのときはカットしておく
$listsymbolnumber = scalar(@{$main::nolinksymbols_separater});
for($my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
if( substr($mysymbol, -1 , 1) eq
@{$main::nolinksymbols_separater}[$my_i] ){
chop($mysymbol);
}
}
# m コマンド を使って、文字列が含まれるか否かを検査
# EXPR =~ m/RE/ ： EXPRがRE（正規表現で）
# 含まれると 1 を返すので if 内で正偽の判断ができる
$listsymbolnumber = scalar(@{$main::nolinksymbols});
for($my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
if( $mysymbol =~ m/@{$main::nolinksymbols}[$my_i]/ ){
return 1;
}
}
return 0;
}
# リンク文字列を作成する
# URLを返すだけ
sub makelink{
my $this = shift;
my $mysymbol = $_[0]; # 可読性のため
my $mycategory = $_[1]; # 可読性のため
my $temp = "";
$temp .= $main::hypertext1;
$temp .= $mycategory;
$temp .= $main::hypertext2;
# 最後のひと文字がコンマなどのときはリンク文字列から削る
$listsymbolnumber = scalar(@{$main::nolinksymbols_separater});
for($my_i = 0; $my_i < $listsymbolnumber; $my_i++ ){
if( substr($mysymbol, -1 , 1) eq
@{$main::nolinksymbols_separater}[$my_i] ){
chop($mysymbol);
}
}
$temp .= uri_escape($mysymbol);
# uri_escapeを追加 query に使う遺伝子記号などをエスケープ 2015年1月13日
return $temp;
}
# 挿入の記号から、identifierを取り除く
sub makeswithoutidentifier{
my $this = shift;
my $lastparen = rindex($this->{mytext},'}');
my $temp = "";
$temp .= substr($this->{mytext},0,($lastparen+1));
return $temp;
}
# 挿入の記号から、identifierだけを返す
sub makesinsertionidentifier{
my $this = shift;
my $lastparen = index($this->{mytext},'}');
my $temp = "";
$temp .= substr($this->{mytext},($lastparen+1));
return $temp;
}
# 挿入の記号から、shortのconstructを作る
sub makeshortconstruct{
my $this = shift;
my $firstparen = index($this->{mytext},'{');
my $lastequal = rindex($this->{mytext},'=');
my $lastparen = 0;
my $temp = "";
$temp .= substr($this->{mytext},0,($firstparen+1));
if($lastequal<0){
# もともと short のときは元に戻るように細工しておく
$lastequal = $firstparen;
}
$temp .= substr($this->{mytext}, ($lastequal+1));
$lastparen = index($temp,'}');
$temp = substr($temp, 0, ($lastparen+1));
return $temp;
}
# allele の部分（[と]で囲まれた部分）を削る
# そのようなものがなければ（表記としてはヘンなのだが）、
# 当然そのままにしておく
sub dropallele{
my $this = shift;
my $myparam = $_[0]; # 可読性のため
my $myfirst = rindex($myparam,'[');
if($myfirst>0){
return substr( $myparam, 0, $myfirst);
} else {
return $myparam;
}
}
# 「Class」 定義ここまで
#
######################################################################
**出力例＆サンプル [#p63cf8fc]
出力例 → [[こちら>http://www.cis.kit.ac.jp/~tomaru/pukiwiki/?plugin=attach&refer=FlyBase%A4%D8%A4%CE%A5%EA%A5%F3%A5%AF&openfile=link_to_flybase_out20150115.html]]~
ドラッグ＆ドロップで使えるもの（サンプル入り） → &ref(link_to_flybase20150115.zip);~
古いものも残しおきます。
深い意味はありません。
|Today:&counter(today);|Yesterday:&counter(yesterday);|Total:&counter(); since 11 May 2010|
![[PukiWiki]](image/tomarufront.png "[PukiWiki]")
