Perl で環境変数は package で設定しよう。

サブルーチンでなくベタ書きしている部分は require 時に実行されるので、source と同じ感覚で使えます。


use lib "hoge";
require 'fuga.pl';

# in fuga.pl
package fuga;
...
$ENV{PATH} .= ;
$ENV{LD_LIBRARY_PATH} .= ;
...
1;

2016-07-28 : Work-Linux-Perl : コメント : 0 : トラックバック : 0
Pagetop

あるファイルをサーチして再帰的に処理するには File::Find::find を使おう

File::Find::find でサーチパスを指定します。
ファイル毎に再帰的にファンクションがコールされます。
ファイル名は $File::Find::name で取得し、その際にはファイルがあるディレクトリがカレントになります。

下記は Makefile をサーチしてそれぞれで clean を実行する例です。


File::Find::find (\&do_clean, "../hoge");

sub do_clean {
my $find_file = $File::Find::name;
if ($find_file =~ /\/Makefile$/) {
print $File::Find::dir . "\n";
if (-r "Makefile") {
system "make clean";
}
}
};

2016-07-15 : Work-Linux-Perl : コメント : 0 : トラックバック : 0
Pagetop

Perlでモジュールにパスを通すには環境変数 PERL5LIB に指定するのが簡単

Perlを実行する前にこんな感じでライブラリを保存しているパスを指定しておきます。

setenv PERL5LIB "./lib"

参照:
http://qiita.com/xtetsuji/items/7007df9ff3b653c7326e
2016-06-22 : Work-Linux-Perl : コメント : 0 : トラックバック : 0
Pagetop

perl で配列を使った foreach のネストは注意が必要

このような構成の場合、@fuga は最初の foreach の中で定義しないと2回目のループでは消えてしまいます。


foreach(@hoge)
foreach(@fuga)
...

2015-10-29 : Work-Linux-Perl : コメント : 0 : トラックバック : 0
Pagetop

perlでuniqを使うにはこうしよう

外部moduleを使わないのが手軽でいいです。


my @unique = do { my %seen; grep { !$seen{$_}++ } @data };


参照:
http://perlmaven.com/unique-values-in-an-array-in-perl
2015-03-24 : Work-Linux-Perl : コメント : 0 : トラックバック : 0
Pagetop

perlである要素が配列の中に存在するかを調べた結果を条件文で使うにはこうしよう

各配列の要素が$_に展開されます。
戻り値はマッチング結果の配列です。


if (grep {/$string$/} @array) {;}


参照:
http://dqn.sakusakutto.jp/2011/08/perl_10.html
2015-03-19 : Work-Linux-Perl : コメント : 0 : トラックバック : 0
Pagetop

perlでファイル名文字列の拡張子削除はこうしよう

単純な例ですが、凝ったものでなければだいたいこれでいけます。


$_ =~ s/^(.*)\..*$/$1/;

2015-03-17 : Work-Linux-Perl : コメント : 0 : トラックバック : 0
Pagetop

8bit RGB⇔YUV422変換

Perlで作ってみた。YUV422の並びは、Y0 Y1 U V ...


#!/usr/bin/perl -w

use strict;
use warnings;
use Getopt::Std;

my %opt = ();
getopts("hr:y:", \%opt);
if ($opt{h}) { &help(); }
if ($opt{r}) { &rgb_2_yuv422(); }
if ($opt{y}) { &yub422_2_rgb(); }

sub help {
print << "ENDLINE";
Usage: ${0} [Optin]
Option:
-h :help
-r arg :rgb2yuv
-y arg :yub2rgb
ENDLINE
}

sub rgb_2_yuv422 {
my $infile = "$opt{r}";
my $outfile = "$opt{r}.yuv";
open (INFILE, "<$infile") || die "$infile: $!";
open (OUTFILE, ">$outfile") || die "$outfile: $!";
binmode INFILE;
binmode OUTFILE;

my $coun = 0;
my $buff;
my $r; my $g; my $b;
my $y; my $u; my $v;
my @y; my @u; my @v;
while (read(INFILE, $buff, 1)) {
my $val = unpack("C1", $buff);

if ($coun == 0 || $coun == 3) {
$r = $val;

$coun++;
}
elsif ($coun == 1 || $coun == 4) {
$g = $val;

$coun++;
}
elsif ($coun == 2 || $coun == 5) {
$b = $val;

$y = 0.299*$r + 0.587*$g + 0.114*$b;
$u = -0.169*$r - 0.331*$g + 0.500*$b + 128;
$v = 0.500*$r - 0.419*$g - 0.081*$b + 128;

$y = &lotate($y, 255);
$u = &lotate($u, 255);
$v = &lotate($v, 255);

if ($coun == 2) {
$y[0] = $y;
$u[0] = $u;
$v[0] = $v;

$coun++;
}
else {
$y[1] = $y;

$val = pack("C1", $y[0]); print OUTFILE $val;
$val = pack("C1", $y[1]); print OUTFILE $val;
$val = pack("C1", $u[0]); print OUTFILE $val;
$val = pack("C1", $v[0]); print OUTFILE $val;

$coun = 0;
}
}
}

}

sub yub422_2_rgb {
my $infile = "$opt{y}";
my $outfile = "$opt{y}.rgb";
open (INFILE, "<$infile") || die "$infile: $!";
open (OUTFILE, ">$outfile") || die "$outfile: $!";
binmode INFILE;
binmode OUTFILE;

my $coun = 0;
my $buff;
my @y; my @u; my @v;
my @r; my @g; my @b;
while (read(INFILE, $buff, 1)) {
my $val = unpack("C1", $buff);

my $i;
if ($coun == 0 || $coun == 1) {
$y[$coun] = $val;

$coun++;
}
elsif ($coun == 2) {
for ($i = 0; $i < 2; $i++) {
$u[$i] = $val - 128;
}

$coun++;
}
elsif ($coun == 3) {
for ($i = 0; $i < 2; $i++) {
$v[$i] = $val - 128;
}

for ($i = 0; $i < 2; $i++) {
$r[$i] = $y[$i] + 1.402*$v[$i];
$g[$i] = $y[$i] - 0.344*$u[$i] - 0.714*$v[$i];
$b[$i] = $y[$i] + 1.772*$u[$i] ;

$r[$i] = &lotate($r[$i], 255);
$g[$i] = &lotate($g[$i], 255);
$b[$i] = &lotate($b[$i], 255);

$val = pack("C1", $r[$i]); print OUTFILE $val;
$val = pack("C1", $g[$i]); print OUTFILE $val;
$val = pack("C1", $b[$i]); print OUTFILE $val;
}

$coun = 0;
}
}

}

sub lotate {
my $val = $_[0];
my $lim = $_[1];

if ($lim < $val) { $val = $lim; }
elsif ($val < 0) { $val = 0; }
else { $val = int $val; }

return $val;
}


テーマ : プログラミング
ジャンル : コンピュータ

2011-04-19 : Work-Linux-Perl : コメント : 0 : トラックバック : 0
Pagetop

BB生成スクリプト

Verilog RTLのBlackBox生成用スクリプトです。

例によって、VerilogPerlの某有名サイトを参考にしています。

出力が不定にならないように、固定値を出力しています。
Highが希望される信号は、個別に指定します。例えば以下の例ではPREADYですね。


#!/usr/bin/perl -w

use strict;
use warnings;
use Getopt::Std;
use Verilog::Netlist;

# -----------------------------------------------------------
# Gloval variable
my @portname = ();
my @portdirection = ();

# -----------------------------------------------------------
# Option Analysys

my %opt = ();
getopts("hb", \%opt);
if ($opt{h}) { &help(); }
if ($opt{b}) {
my @FileList = @ARGV,

my $NetList = new Verilog::Netlist;
ReadVerilogFiles($NetList, \@FileList);

PrintModule($NetList);
}

sub help()
{
print << "ENDLINE";
Usage: ${0} [Optin]
Option:
-h :help
-b rtl :making black box
ENDLINE
}

sub ReadVerilogFiles {
my ($netlist, $r_filelist) = @_;

foreach my $file (@{$r_filelist}) {
$netlist->read_file(filename=>$file);
}

$netlist->link(); # connection resolve
}

sub PrintModule {
my ($netlist) = @_;

foreach my $module ($netlist->modules_sorted) {
my @ports;
push(@ports, $module->ports_ordered);
if ($#ports == -1) { next; }

my $outfilename;

$outfilename = "./" . $module->name . ".v";
open (OUTFILE, ">$outfilename") || die "$outfilename: $!";

print OUTFILE "module " . $module->name;
print OUTFILE " (\n";

# 1.signal dicraration
for (my $index=0; $index < $#ports; $index++) {
print OUTFILE ' 'x4, $ports[$index]->name, ",\n";
}
print OUTFILE ' 'x4, $ports[$#ports]->name ",\n";

print OUTFILE ");\n";
print OUTFILE "\n";

# 2.signal dicraration
for (my $index=0; $index <= $#ports; $index++) {
# direction
print OUTFILE ' 'x4;
if ($ports[$index]->direction eq 'in') {
print OUTFILE "input ";
} elsif ($ports[$index]->direction eq 'out') {
print OUTFILE "output ";
} else {
print OUTFILE "inout ";
}
# msb/lsb
if (defined($ports[$index]->net->width) && $ports[$index]->net->width != 1){
print OUTFILE '[',$ports[$index]->net->msb;
print OUTFILE ':',$ports[$index]->net->lsb,'] ';
} else {
print OUTFILE ' 'x6;
}
# port name
print OUTFILE $ports[$index]->name,";\n";
}

print OUTFILE "\n";

# 3.output signal fix value
for (my $index=0; $index <= $#ports; $index++) {
# assign
if ($ports[$index]->direction eq 'out') {
# port name
print OUTFILE ' 'x4;
print OUTFILE "assign ";
my $signal = $ports[$index]->name;
print OUTFILE $signal;
print OUTFILE " = ";
my $sigwidth = $ports[$index]->net->width;
if ($sigwidth eq "") { $sigwidth = 1; }
print OUTFILE $sigwidth;
if ($signal =~ /PREADY/) { print OUTFILE "'d1;\n"; }
else { print OUTFILE "'d0;\n"; }
}
}

print OUTFILE "\nendmodule\n";

close (OUTFILE);

}
}


テーマ : プログラミング
ジャンル : コンピュータ

2011-03-11 : Work-Linux-Perl : コメント : 0 : トラックバック : 0
Pagetop
ホーム  次のページ »

プロフィール

zive

Author:zive
大阪在住、男

ブログ検索

月別アーカイブ

FC2カウンター