p1k3-wala/pages/PerlCode

WareLogging. Some bits of PerlLanguage. Also look at PerlCompatibleRegularExpressions.

= one-liners and the like =

 $/ = "\n"; # record separator

 $re = qr/whatever/; # store a RegEx

 # ridiculous (shouldn't cut or basename do this?), but...
 # in your shell - count uniquely named jpgs:
 find . -iname '*.jpg' | perl -n -e 's{.*/(.*$)}{$1}; print'| sort | uniq | wc -l

 # 'course, find can do the filename trimming by itself:
 find . -iname '*.jpg' -printf '%f\n'|sort|uniq|wc -l

= return a date-based directory name =

(Edit this page to see brackets in the proper spot, until I fix the crappy markup around here.)

 #!/usr/bin/perl
 use POSIX qw(strftime);
 my @t = localtime;
 my $dir = strftime( "%Y/%m/%e", @t );
 $dir =~ s/\/[0 ]/\//g;
 print $dir;

= dispatch table to package subs =

 package Whatever::Thing;

 my %tags = (
   p      => \&tag,
   em     => \&tag,
   small  => \&tag,
   strong => \&tag,
   table  => \&tag,
 );

 # Install appropriate subs in symbol table:
 for my $key (keys %tags) {
   *$key = sub { $tags{$key}->($key, @_) };
 }

 sub tag {
   my ($tag, $text, $class) = @_;

   if (defined $class) {
     return qq{<$tag class="$class">$text</$tag>};
   } else {
     return qq{<$tag>$text</$tag>};
   }
 }

 # should give you '<p class="item"><strong>Some stuff.</strong></p>'
 print p(strong('Some stuff'), 'item');

= print every so many lines =

 #!/usr/bin/perl

 @lines = <STDIN>;

 $start = 0; # array index not line - first line is 0
 $skip = 7;
 $count = $skip;

 for ( @lines[$start .. $#lines] ) {
   print if ( $count % $skip == 0 );
   $count++;
 }

= recursive file rename =

This still running in the background on about a gazillion images. Let's hope it doesn't break anything. Yes, next time I will stop being an idiot and use find(1).

  #!/usr/bin/perl
  
  use strict;
  use warnings;
  
  change(".");
  
  sub change {
      my ($dir) = @_;
      print "Trying $dir\n";
  
      my $dh;
      opendir $dh, $dir;
        my @files = readdir $dh;
      closedir $dh;
  
      for my $file (@files) {
          next if ($file =~ m/^\.\.$/);
          next if ($file =~ m/^\.$/);
  
          if (-d "$dir/$file") {
  
              # recursion.
              change("$dir/$file");
  
          } elsif ($file =~ m/\.jpe?g/i) {
              next if ($file =~ m/\.jpg$/);
              my $new_file = $file;
              $new_file =~ s/\.jpe?g/\.jpg/i;
              rename ("$dir/$file", "$dir/$new_file");
              print "$dir/$file to: $dir/$new_file\n";
          }
      }
  
  }

= grep =

 $ perl
 %ignore = (blah => 1);
 @wog = qw(blah wog tog dog);
 @wog = grep { ! $ignore{$_} } @wog;
 print @wog;
 wogtogdog

 $ perl
 $n = 100;
 if ( grep { $n % $_ != 0 } (1..10) ) {
   print $n;
 }
 100