notes.splitbrain.org

This page is read only. You can view the source, but not change it. Ask your administrator if you think this is wrong.
====== Perl ======

===== Pseudo XML configreader =====

  * Pseudo XML [[configreader]]


===== Walk a hash =====

<code perl>
while (my ($key,$val) = each(%hash) ){
  print "$key:$val\n";
}
</code>

An alternative way:

<code perl>
foreach my $key (keys %hash) {
   print "$key:$hash{$key}\n";
}
</code>

> An more common and elegant way is to use the built-in variable $_:

> <code perl>
foreach (keys %hash)
{
   print $_, ":", $hash{$_}, "\n";      # or "$_:$hash{$_}\n" instead
}
</code>

===== Removing duplicates from an array =====

These three lines will remove all duplicate entries from the ''@myarray'' array. The array will be sorted, too.

<code perl>
undef %temp;
@temp{@myarray} = ();
@myarray = sort keys %temp;
</code>

===== Recursive Directory Listing =====

<code perl>
sub readFiles($) {
 my $path=$_[0];

 opendir(ROOT, $path);
 my @files = readdir(ROOT);
 closedir(ROOT);

 foreach my $file (@files) {
   next if($file =~ /^\./);    #skip upper dirs and hidden files
   my $fullFilename = "$path/$file";

   if (-d $fullFilename) {
     readFiles($fullFilename); #Recursion
     next;
   }

   #do something with the files    
 }
}

# See also: File::Find
</code>

===== URL-Encode a string =====

This is a nice sub to URL-encode a string for passing it to a CGI or something.

<code perl>
sub ue($){
  my $url = $_[0];
  $url =~ s/([\W])/"%" . uc(sprintf("%2.2x",ord($1)))/eg;
  return $url;
}
</code>

===== Check if a value is in an array =====

This sub returns true if $needle is found in the @haystack.

<code perl>
sub isin($@){
  my $needle = shift;
  chomp($needle);
  my @haystack = @_;
  foreach my $row (@haystack){
    return 1 if ($needle eq $row);
  }
  return 0;
}

# or: 

sub isin {
my ($needle, @haystack) = @_;
my %lookup = map {$_=>1} @haystack;
return 1 if $lookup{$needle};
return 0;
}

# or:

sub isin {
my ($needle, @haystack) = @_;
return 1 if (grep $needle eq $_, @haystack);
return 0;
}

</code>

===== Shuffle an Array =====

This is a nice one from the cookbook

<code perl>
# fisher_yates_shuffle( \@array ) : generate a random permutation
# of @array in place
sub fisher_yates_shuffle {
  my $array = shift;
  my $i;
  for ($i = @$array; --$i; ) {
      my $j = int rand ($i+1);
      next if $i == $j;
      @$array[$i,$j] = @$array[$j,$i];
  }
}
  
fisher_yates_shuffle( \@array );    # permutes @array in place
</code>

===== Get current time =====

<code perl>
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
</code>

or to just print the time
<code perl>
print scalar localtime();
</code>

or to get the time in epoch

<code perl>
$epoch = time();
//time passes
print scalar localtime($epoch);
</code>

    * for accurate time measurement use Time::HiRes
    * for date parsing use Data::Manip

===== mkdir -p =====

This creates a full directory structure like ''mkdir -p'' on the shell.

<code perl>
sub mkdirp(){
  my $dir = shift();
  my @parts = split('/',$dir);

  my $path = '';

  foreach my $part (@parts){
    $path .= "/$part";

    unless(-d $path){
      my $ok = mkdir($path);
      return $ok unless($ok);
    }
  }
  return 1;
}
</code>

===== Ask for confirmation =====

Simple sub to ask a user for confirming a given Question

<code perl>
sub yesno {
  print shift().' [Y/n]: ';
  return <STDIN>!~/^\s*n\s*$/i;
}
</code>

===== Access MySQL =====

<code perl>
use DBI;
$dbh = DBI->connect("dbi:mysql:$db_database:$db_server",$db_user,$db_password) || die("Can't connect");


# select
$SELECT = "SELECT * FROM table"; 
$result = $dbh->selectall_arrayref($SELECT);

$row=0;
while (defined($result->[$row][0])){
  #do somthing with $result->[$row][0]
  $row++
}

# insert
$value = $dbh->quote($value);
$INSERT = "INSERT INTO table SET foo=$value";
$dbh->do($INSERT);

$insertid = $dbh->{'mysql_insertid'};

# use parameters
my $statement = $dbh->prepare(q{
SELECT field FROM table WHERE id = ?
});

$statement->execute($id);
my ($fieldValue) = $statement->fetchrow_array;

</code>

===== UTF8 to latin1 in Perl 5.8 =====

Perl tries to be clever about Unicode in Version 5.8 - if you want to force an encoding (eg. for inserting into a DB) use the encode function:

<code perl>
use Encode;

$octets = encode("iso-8859-15", $utf8string);
</code>

===== latin1 to UTF8 =====

And the other way around... To use in an XML file or for an HTML page

<code perl>
use HTML::Entities;

$utf8string = $iso-8859-15string;
encode_entity($utf8string);
</code>

===== Print a sourcefile with linenumbers =====

  perl -ne 'printf("%0.3d %s", ++$i, $_)' < source.php > source.txt

===== Parse a CSV line =====

<code perl>
sub parseline(){
  my $line = $_[0];
     $line =~ s/^\s+//;
     $line =~ s/\s+$//;
  my @chars = split(//,$line);

  my $quote="'";
  my $sep=',';

  my @fields;
  my $current = '';
  my $istext = 0;


  for($i=0;$i<length($line);$i++){
    if($chars[$i] eq $quote){          #handle quote chars
      if($istext){
        if($chars[$i+1] eq $quote){
          # it's a quoted quote
          $curent .= $quote;
          $i++; #skip next char
        }else{
          $istext = 0; #end of text
        }
      }else{
        $istext = 1; #start text
      }
    }elsif($chars[$i] eq $sep){        #handle seperators
      if($istext){
        $current .= $sep;
      }else{
        $fields[scalar(@fields)] = $current;
        $current = '';
      }
    }else{                             #handle normal chars
      $current .= $chars[$i];
    }
  }
  #add remaining chars if any
  $fields[scalar(@fields)] = $current if($current);

  return @fields;
}

# or: 
use Text::CSV;
my $csv = Text::CSV->new();
$csv->parse($line);
my @fields = $csv->fields();

# also backwards:
$csv->combine(@fields);
$line = $csv->string;



</code>