• Pseudo XML configreader

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

An alternative way:

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

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

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

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

undef %temp;
@temp{@myarray} = ();
@myarray = sort keys %temp;

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

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

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

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

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;
}

This is a nice one from the cookbook

# 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

($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);

or to just print the time

print scalar localtime();

or to get the time in epoch

$epoch = time();
//time passes
print scalar localtime($epoch);

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

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

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;
}

Simple sub to ask a user for confirming a given Question

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

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;

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:

use Encode;
 
$octets = encode("iso-8859-15", $utf8string);

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

use HTML::Entities;
 
$utf8string = $iso-8859-15string;
encode_entity($utf8string);

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

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;