perlsnippets
Differences
This shows you the differences between two versions of the page.
Both sides previous revisionPrevious revisionNext revision | Previous revision | ||
perlsnippets [2007/07/26 09:46] – 84.92.108.250 | 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 " | ||
+ | } | ||
+ | </ | ||
+ | |||
+ | An alternative way: | ||
+ | |||
+ | <code perl> | ||
+ | foreach my $key (keys %hash) { | ||
+ | print " | ||
+ | } | ||
+ | </ | ||
+ | |||
+ | > An more common and elegant way is to use the built-in variable $_: | ||
+ | |||
+ | > <code perl> | ||
+ | foreach (keys %hash) | ||
+ | { | ||
+ | print $_, ":", | ||
+ | } | ||
+ | </ | ||
+ | |||
+ | ===== Removing duplicates from an array ===== | ||
+ | |||
+ | These three lines will remove all duplicate entries from the '' | ||
+ | |||
+ | <code perl> | ||
+ | undef %temp; | ||
+ | @temp{@myarray} = (); | ||
+ | @myarray = sort keys %temp; | ||
+ | </ | ||
+ | |||
+ | ===== Recursive Directory Listing ===== | ||
+ | |||
+ | <code perl> | ||
+ | sub readFiles($) { | ||
+ | my $path=$_[0]; | ||
+ | |||
+ | | ||
+ | my @files = readdir(ROOT); | ||
+ | | ||
+ | |||
+ | | ||
+ | next if($file =~ / | ||
+ | my $fullFilename = " | ||
+ | |||
+ | if (-d $fullFilename) { | ||
+ | | ||
+ | next; | ||
+ | } | ||
+ | |||
+ | #do something with the files | ||
+ | } | ||
+ | } | ||
+ | |||
+ | # See also: File::Find | ||
+ | </ | ||
+ | |||
+ | ===== 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/ | ||
+ | return $url; | ||
+ | } | ||
+ | </ | ||
+ | |||
+ | ===== 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; | ||
+ | } | ||
+ | |||
+ | </ | ||
+ | |||
+ | ===== 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, | ||
+ | } | ||
+ | } | ||
+ | | ||
+ | fisher_yates_shuffle( \@array ); # permutes @array in place | ||
+ | </ | ||
+ | |||
+ | ===== Get current time ===== | ||
+ | |||
+ | <code perl> | ||
+ | ($sec, | ||
+ | </ | ||
+ | |||
+ | or to just print the time | ||
+ | <code perl> | ||
+ | print scalar localtime(); | ||
+ | </ | ||
+ | |||
+ | or to get the time in epoch | ||
+ | |||
+ | <code perl> | ||
+ | $epoch = time(); | ||
+ | //time passes | ||
+ | print scalar localtime($epoch); | ||
+ | </ | ||
+ | |||
+ | * for accurate time measurement use Time::HiRes | ||
+ | * for date parsing use Data::Manip | ||
+ | |||
+ | ===== mkdir -p ===== | ||
+ | |||
+ | This creates a full directory structure like '' | ||
+ | |||
+ | <code perl> | ||
+ | sub mkdirp(){ | ||
+ | my $dir = shift(); | ||
+ | my @parts = split('/', | ||
+ | |||
+ | my $path = ''; | ||
+ | |||
+ | foreach my $part (@parts){ | ||
+ | $path .= "/ | ||
+ | |||
+ | unless(-d $path){ | ||
+ | my $ok = mkdir($path); | ||
+ | return $ok unless($ok); | ||
+ | } | ||
+ | } | ||
+ | return 1; | ||
+ | } | ||
+ | </ | ||
+ | |||
+ | ===== Ask for confirmation ===== | ||
+ | |||
+ | Simple sub to ask a user for confirming a given Question | ||
+ | |||
+ | <code perl> | ||
+ | sub yesno { | ||
+ | print shift().' | ||
+ | return < | ||
+ | } | ||
+ | </ | ||
+ | |||
+ | ===== Access MySQL ===== | ||
+ | |||
+ | <code perl> | ||
+ | use DBI; | ||
+ | $dbh = DBI-> | ||
+ | |||
+ | |||
+ | # select | ||
+ | $SELECT = " | ||
+ | $result = $dbh-> | ||
+ | |||
+ | $row=0; | ||
+ | while (defined($result-> | ||
+ | #do somthing with $result-> | ||
+ | $row++ | ||
+ | } | ||
+ | |||
+ | # insert | ||
+ | $value = $dbh-> | ||
+ | $INSERT = " | ||
+ | $dbh-> | ||
+ | |||
+ | $insertid = $dbh-> | ||
+ | |||
+ | # use parameters | ||
+ | my $statement = $dbh-> | ||
+ | SELECT field FROM table WHERE id = ? | ||
+ | }); | ||
+ | |||
+ | $statement-> | ||
+ | my ($fieldValue) = $statement-> | ||
+ | |||
+ | </ | ||
+ | |||
+ | ===== 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(" | ||
+ | </ | ||
+ | |||
+ | ===== latin1 to UTF8 ===== | ||
+ | |||
+ | And the other way around... To use in an XML file or for an HTML page | ||
+ | |||
+ | <code perl> | ||
+ | use HTML:: | ||
+ | |||
+ | $utf8string = $iso-8859-15string; | ||
+ | encode_entity($utf8string); | ||
+ | </ | ||
+ | |||
+ | ===== Print a sourcefile with linenumbers ===== | ||
+ | |||
+ | perl -ne ' | ||
+ | |||
+ | ===== Parse a CSV line ===== | ||
+ | |||
+ | <code perl> | ||
+ | sub parseline(){ | ||
+ | my $line = $_[0]; | ||
+ | $line =~ s/^\s+//; | ||
+ | $line =~ s/\s+$//; | ||
+ | my @chars = split(//, | ||
+ | |||
+ | my $quote="'"; | ||
+ | my $sep=','; | ||
+ | |||
+ | my @fields; | ||
+ | my $current = ''; | ||
+ | my $istext = 0; | ||
+ | |||
+ | |||
+ | for($i=0; | ||
+ | if($chars[$i] eq $quote){ | ||
+ | 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){ | ||
+ | if($istext){ | ||
+ | $current .= $sep; | ||
+ | }else{ | ||
+ | $fields[scalar(@fields)] = $current; | ||
+ | $current = ''; | ||
+ | } | ||
+ | }else{ | ||
+ | $current .= $chars[$i]; | ||
+ | } | ||
+ | } | ||
+ | #add remaining chars if any | ||
+ | $fields[scalar(@fields)] = $current if($current); | ||
+ | |||
+ | return @fields; | ||
+ | } | ||
+ | |||
+ | # or: | ||
+ | use Text::CSV; | ||
+ | my $csv = Text:: | ||
+ | $csv-> | ||
+ | my @fields = $csv-> | ||
+ | |||
+ | # also backwards: | ||
+ | $csv-> | ||
+ | $line = $csv-> | ||
+ | |||
+ | |||
+ | |||
+ | </ | ||
perlsnippets.txt · Last modified: 2007/10/06 09:07 by grahack