first commit

perl/Examples/Chap1/binary

@@ -0,0 +1,16 @@
+
+
+###
+### binary
+###
+
+## Chapter 1 section 1
+
+sub binary {
+  my ($n) = @_;
+  return $n if $n == 0 || $n == 1; 
+  my $k = int($n/2);
+  my $b = $n % 2;
+  my $E = binary($k);
+  return $E . $b;
+}

perl/Examples/Chap1/check-move

@@ -0,0 +1,29 @@
+
+
+###
+### check_move
+###
+
+## Chapter 1 section 3
+
+@position = (' ', ('A') x 3); # Disks are all initially on peg A
+
+sub check_move {
+  my $i;
+  my ($disk, $start, $end) = @_;
+  if ($disk < 1 || $disk > $#position) {
+    die "Bad disk number $disk. Should be 1..$#position.\n";
+  }
+  unless ($position[$disk] eq $start) {
+    die "Tried to move disk $disk from $start, but it is on peg $position[$disk].\n";
+  }
+  for $i (1 .. $disk-1) {
+    if ($position[$i] eq $start) {
+      die "Can't move disk $disk from $start because $i is on top of it.\n";
+    } elsif ($position[$i] eq $end) {
+      die "Can't move disk $disk to $end because $i is already there.\n";
+    }
+  }
+  print "Moving disk $disk from $start to $end.\n";
+  $position[$disk] = $end;
+}

perl/Examples/Chap1/dir-walk-cb

@@ -0,0 +1,29 @@
+
+
+###
+### dir_walk_callbacks
+###
+
+## Chapter 1 section 5
+
+sub dir_walk {
+  my ($top, $filefunc, $dirfunc) = @_;
+  my $DIR;
+
+  if (-d $top) {
+    my $file;
+    unless (opendir $DIR, $top) {
+      warn "Couldn't open directory $code: $!; skipping.\n";
+      return;
+    }
+
+    my @results;
+    while ($file = readdir $DIR) {
+      next if $file eq '.' || $file eq '..';
+      push @results, dir_walk("$top/$file", $filefunc, $dirfunc);
+    }
+    return $dirfunc->($top, @results);
+  } else {
+    return $filefunc->($top);
+  }
+}

perl/Examples/Chap1/dir-walk-cb-def

@@ -0,0 +1,29 @@
+
+
+###
+### dir_walk_callbacks_defaults
+###
+
+## Chapter 1 section 5
+
+sub dir_walk {
+  my ($top, $filefunc, $dirfunc) = @_;
+  my $DIR;
+
+  if (-d $top) {
+    my $file;
+    unless (opendir $DIR, $top) {
+      warn "Couldn't open directory top: $!; skipping.\n";
+      return;
+    }
+
+    my @results;
+    while ($file = readdir $DIR) {
+      next if $file eq '.' || $file eq '..';
+      push @results, dir_walk("$top/$file", $filefunc, $dirfunc);
+    }
+    return $dirfunc ? $dirfunc->($top, @results) : () ;
+  } else {
+    return $filefunc ? $filefunc->($top): () ;
+  }
+}

perl/Examples/Chap1/dir-walk-simple

@@ -0,0 +1,26 @@
+
+
+###
+### dir_walk_simple
+###
+
+## Chapter 1 section 5
+
+sub dir_walk {
+  my ($top, $code) = @_;
+  my $DIR;
+  
+  $code->($top);
+  
+  if (-d $top) {
+    my $file;
+    unless (opendir $DIR, $top) {
+      warn "Couldn't open directory $top: $!; skipping.\n";
+      return;
+    }
+    while ($file = readdir $DIR) {
+      next if $file eq '.' || $file eq '..';
+      dir_walk("$top/$file", $code);
+    }
+  }
+}

perl/Examples/Chap1/dir-walk-sizehash

@@ -0,0 +1,27 @@
+
+
+###
+### dir-walk-sizehash
+###
+
+## Chapter 1 section 5
+
+sub file {
+  my $file = shift;
+  [short($file), -s $file];
+}
+
+sub short {
+  my $path = shift;
+  $path =~ s{.*/}{};
+  $path;
+}
+sub dir {
+  my ($dir, @subdirs) = @_;
+  my %new_hash;
+  for (@subdirs) {      
+    my ($subdir_name, $subdir_structure) = @$_;
+    $new_hash{$subdir_name} = $subdir_structure;
+  }
+  return [short($dir), \%new_hash];
+}

perl/Examples/Chap1/extract-headers

@@ -0,0 +1,28 @@
+
+
+###
+### extract_headers
+###
+
+## Chapter 1 section 7
+
+@tagged_texts = walk_html($tree, sub { ['MAYBE', $_[0]] }, 
+                                 \&promote_if_h1tag);
+
+sub promote_if_h1tag {
+  my $element = shift;
+  if ($element->{_tag} eq 'h1') {
+    return ['KEEPER', join '', map {$_->[1]} @_];
+  } else {
+    return @_;
+  }
+}
+sub extract_headers {
+  my $tree = shift;
+  my @tagged_texts = walk_html($tree, sub { ['MAYBE', $_[0]] }, 
+                                      \&promote_if_h1tag);
+  my @keepers = grep { $_->[0] eq 'KEEPER' } @tagged_texts;
+  my @keeper_text = map { $_->[1] } @keepers;
+  my $header_text = join '', @keeper_text;
+  return $header_text;
+}

perl/Examples/Chap1/factorial-broken

@@ -0,0 +1,13 @@
+
+
+###
+### factorial_nonreentrant
+###
+
+## Chapter 1 section 2.1
+
+sub factorial {
+  ($n) = @_;
+  return 1 if $n == 0;
+  return factorial($n-1) * $n;
+}

perl/Examples/Chap1/find-share

@@ -0,0 +1,17 @@
+
+
+###
+### find_share.pl
+###
+
+## Chapter 1 section 8.2
+
+sub find_share {
+  my ($target, $treasures) = @_;
+  return [] if $target == 0;
+  return    if $target < 0 || @$treasures == 0;
+  my ($first, @rest) = @$treasures;
+  my $solution = find_share($target-$first, \@rest);
+  return [$first, @$solution] if $solution;
+  return         find_share($target       , \@rest);
+}

perl/Examples/Chap1/hanoi

@@ -0,0 +1,23 @@
+
+
+###
+### hanoi
+###
+
+## Chapter 1 section 3
+
+# hanoi(N, start, end, extra)
+# Solve Tower of Hanoi problem for a tower of N disks,
+# of which the largest is disk #N.  Move the entire tower from
+# peg `start' to peg `end', using peg `extra' as a work space
+  
+sub hanoi {
+  my ($n, $start, $end, $extra) = @_;
+  if ($n == 1) { 
+    print "Move disk #1 from $start to $end.\n";  # Step 1
+  } else {
+    hanoi($n-1, $start, $extra, $end);            # Step 2
+    print "Move disk #$n from $start to $end.\n"; # Step 3
+    hanoi($n-1, $extra, $end, $start);            # Step 4
+  }
+}

perl/Examples/Chap1/promote-if

@@ -0,0 +1,27 @@
+
+
+###
+### promote_if
+###
+
+## Chapter 1 section 7.1
+
+sub promote_if {
+  my $is_interesting = shift;          
+  my $element = shift;
+  if ($is_interesting->($element->{_tag}) {
+    return ['keeper', join '', map {$_->[1]} @_];
+  } else {
+    return @_;
+  }
+}
+
+
+## Chapter 1 section 7.1
+
+my @tagged_texts = walk_html($tree, 
+                             sub { ['maybe', $_[0]] }, 
+                             sub { promote_if(
+                                     sub { $_[0] eq 'h1' },
+                                     $_[0])
+                             });

perl/Examples/Chap1/total-size

@@ -0,0 +1,28 @@
+
+
+###
+### total_size
+###
+
+## Chapter 1 section 4
+
+sub total_size {
+  my ($top) = @_;
+  my $total = -s $top;
+  my $DIR;
+
+  return $total if -f $top;
+  unless (opendir $DIR, $top) {
+    warn "Couldn't open directory $top: $!; skipping.\n";
+    return $total;
+  }
+
+  my $file;
+  while ($file = readdir $DIR) {
+    next if $file eq '.' || $file eq '..';
+    $total += total_size("$top/$file");
+  }          
+  
+  closedir $DIR;
+  return $total;
+}

perl/Examples/Chap1/total-size-broken

@@ -0,0 +1,24 @@
+
+
+###
+### total_size_broken
+###
+
+## Chapter 1 section 4
+
+sub total_size {
+  my ($top) = @_;
+  my $total = -s $top;
+  return $total if -f $top;
+  unless (opendir DIR, $top) {
+    warn "Couldn't open directory $top: $!; skipping.\n";
+    return $total;
+  }
+  my $file;
+  while ($file = readdir DIR) {
+    next if $file eq '.' || $file eq '..';
+    $total += total_size("$top/$file");
+  }
+  closedir DIR;
+  return $total;
+}

perl/Examples/Chap1/untag-html

@@ -0,0 +1,19 @@
+
+
+###
+### untag_html
+###
+
+## Chapter 1 section 7
+
+sub untag_html {
+  my ($html) = @_;
+  return $html unless ref $html;   # It's a plain string
+
+  my $text = '';
+  for my $item (@{$html->{_content}}) {
+    $text .= untag_html($item);
+  }
+    
+  return $text;
+}

perl/Examples/Chap1/walk-html

@@ -0,0 +1,18 @@
+
+
+###
+### walk_html
+###
+
+## Chapter 1 section 7
+
+sub walk_html {
+  my ($html, $textfunc, $elementfunc) = @_;
+  return $textfunc->($html) unless ref $html;   # It's a plain string
+
+  my @results;
+  for my $item (@{$html->{_content}}) {
+    push @results, walk_html($item, $textfunc, $elementfunc);
+  }
+  return $elementfunc->($html, @results);
+}