Differences

This shows you the differences between two versions of the page.

--- perlsnippets [2007/04/16 18:21] – old revision restored andi
+++ perlsnippets [2007/10/06 09:07] (current) – deleted test grahack
@@ Line 1: / Line 1: @@
+====== 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>