水曜日, 3月 14, 2007

fetchrow_array


my (@TO) = &get_user_list($dbh);

foreach $to1 (@TO){
   print "$to1\n";
}

sub get_user_list() {

   ...
   my($list, @USER);
   while ( $list = $sth->fetchrow_array() ){
      push(@USER,$list);
   }
  $sth->finish();
   return @USER;
}

ラベル:

fetchrow_hashref

my (@M_ID) = &get_user_list($dbh);

foreach my $hash (@M_ID){
   $id = $hash->{m_id};
   $id = $hash->{m_email};
}

sub get_user_list() {

   ....
    my(@M_ID);
    while(my $data=$sth->fetchrow_hashref()){
        push(@M_ID,$data);
    }
    $sth->finish();
    return @M_ID;
}

ラベル: , ,

土曜日, 3月 10, 2007

Perl call by reference hash subroutines

#!/usr/bin/perl

my %data=();
sub1(\%data);
foreach $key ( sort keys %data ) {
  print "$key:$data{$key} \n";
}

sub sub1{
  my ($x) = @_;
  for ($i = 0; $i <= 10 ; $i++)
  {
    $x->{$i} = $i;
  }
}




ラベル: ,

Perl call by reference array subroutines

#!/usr/bin/perl
my @array = ();

sub1(\@array);
print @array;

sub sub1{
  my ($x) = @_;
  for ($i = 0; $i <= 10 ; $i++)
  {
  $x->[$i] = $i;
 # $$x[$i] = $i;# also is OK.
  }
}



ラベル:

木曜日, 3月 01, 2007

Data::FormValidator

#!/usr/bin/perl -w
use strict;
$++;
use CGI; use CGI::Carp qw( fatalsToBrowser );
use Data::FormValidator; use HTML::Template;
use Data::Dumper;
my ( $cgi, $dfv_profile, $results, $template );
$cgi = new CGI;
print $cgi->header;
$dfv_profile = {

'required' => [
qw( fname lname emails password1 password2 postal1 postal2 )
],
constraint_methods => {
postal1 => sub { my ($dfvr, $value) = @_; return ($value =~ m/^\d{3}$/o); },
postal2 => sub { my ($dfvr, $value) = @_; return ($value =~ m/^\d{4}$/o); },
},
};



$results = Data::FormValidator->check( $cgi, $dfv_profile );my $template1 = 'index.html';
if( $ENV{'REQUEST_METHOD'} eq "POST" ){ $template1 = 'temp.html'; }
$template = HTML::Template->new( 'filename' => $template1, 'die_on_bad_params' => 0, );

if ( $results->has_invalid or $results->has_missing ) {
# something's wrong, which you can
# access what exactly from the
# $results object
my $res_dump = Dumper( $results );
$template->param( 'some_errors' => 1, 'results' => $res_dump, );
if ( $results->has_invalid ) {
foreach my $f ( $results->invalid ) {
$template->param($f =>$f);
}

}

} else {
# the user provided complete and valid
# data ... it's cool to proceed
}
print $template->output;

ラベル:

for qw

#!/usr/local/bin/perl
package main;
use strict;
my %hash = ();
$hash{$_} = 1 for qw(nickname article);
foreach my $key ( keys( %hash ) ) {
print "key: $key\n";
print "value: $hash{$key} \n"
}

水曜日, 2月 28, 2007

constant ARRAY

use constant ARRAY1 => ('hoge'=>'aaa','hoge2'=>'bbb','hoge3'=>'ccc');
%array2 = ARRAY1;
print $array2{'hoge'},"\n";

foreach my $key( keys %array2 ){
print "$key: $array2{$key}", "\n";
}

月曜日, 2月 26, 2007

sample "Class::Inspector" perl

#!/usr/local/bin/perl

use strict;use Class::Inspector;
package Test;
sub test_01 { print "test_01\n";}
sub test_02 { print "test_02\n";}

for my $m (sort grep /^test_/, @{Class::Inspector->methods('Test')}) {
Test->$m();
}

-result-

test_01
test_02

ラベル:

水曜日, 1月 31, 2007

find and grep with condition OR on the unix(linux)

find . \( -iname \*.pm -or -iname \*.pl \) -print xargs grep -in "package"

so if you use OR. you have to use grouping symbol with find and grep.

case black lists
find . ! \( -iname \*.txt -or -iname \*.jpg -or -iname \*.tsv \) -print xargs grep -in "use"

ラベル: , ,

火曜日, 1月 30, 2007

ISA Perl

--HogeA.pm
package HogeA;
use strict;
sub new {
my $class = shift;
my $self = bless {}, $class;
return $self;
}
sub hoge {
my $self = shift;
print "Hoge::hoge\n";
}
1;

--HogeB1.pm
package HogeB1;
use strict;
use HogeA;
our @ISA = qw ( HogeA );
# use base qw(HogeA);
sub new {
my $class = shift;
my $self = HogeA->new();
return bless $self, $class;
}
sub hogehoge{
print "hogehoge\n";
}
1;

--sample.pl
use strict;
use HogeB1;
my $b = HogeB1->new();
$b->hoge;

--result

Hoge::hoge