水曜日, 3月 14, 2007

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;

ラベル:

月曜日, 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"

ラベル: , ,