Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what's changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
base fork: belden/hooking-inc
base: b06baa2443
...
head fork: belden/hooking-inc
compare: fab7cf123a
  • 3 commits
  • 5 files changed
  • 0 commit comments
  • 1 contributor
Commits on Apr 14, 2012
Belden Lyman move a script 4d2e4ca
Belden Lyman add ForceToHead; fix up environment 4fda93d
Belden Lyman final touches fab7cf1
View
9 sample → bin/sample
@@ -9,15 +9,17 @@ my @samples = (
q{cat -n lib/foo.pm},
q{perl -Mfoo -e 'foo->INC'},
q{perl -Mfoo -e 'main->INC'},
+ q{vim -c 'set nu' lib/Fink.pm},
q{perl -MFink -Mstrict -Mwarnings -MData::Dumper -e 1},
q{perl -MIndented -Mstrict -Mwarnings -MData::Dumper -e 1},
q{vim -c 'set nu' bin/toy1},
q{bin/toy1 | egrep -i 'code|somewhere|elsewhere' | grep -v blyman},
+ q{perl -MKingOfTheINC bin/toy1 | egrep -i 'code|somewhere|elsewhere' | grep -v blyman},
q{perl -MAlwaysAtTail -e 'use lib "/tmp"; use something_not_here;'},
q{vim -c 'set nu' lib/GenerateCode.pm},
q{perl -MGenerateCode -e 'use lib "/tmp"; use something_not_here;'},
q{vim -c 'set nu' lib/Peeker.pm},
- q{perl -MPeeker -MDBIx::Class -e 1},
+ q{perl -MPeeker -MDBIx::Class -e 1 | less},
);
GetOptions(
@@ -49,10 +51,11 @@ sub to_xclip {
open my $xclip, '| xclip' or die "fork xclip: $!\n";
my $recurse = (defined $index && $samples[$index + 1])
- ? " ;./sample"
+ ? " ;sample"
: '';
- print $xclip "$sample$recurse\n";
+ my $newline = $sample =~ m{\| less} ? '' : "\n";
+ print $xclip "$sample$recurse$newline";
close $xclip;
}
View
1  environment
@@ -0,0 +1 @@
+export PATH=$(uniquify_environment_variable "/home/blyman/code/hooking-inc/bin:$PATH:$HOME/bin/development-tools")
View
33 lib/ForceToHead.pm
@@ -1,31 +1,26 @@
package ForceToHead;
sub TIEARRAY {
- my ($class, $force_to_head) = @_;
+ my ($class, $head, @body) = @_;
return bless {
- inc => [$head, @INC],
- original => [@INC],
- head => $force_to_head,
+ body => [@body],
+ head => $head,
}, $class;
}
sub FETCH {
my ($self, $index) = @_;
- return $self->{inc}[$index];
+ return ($self->{head}, @{$self->{body}})[$index];
}
sub STORE {
my ($self, $index, $value) = @_;
- if ($index == 0) {
- $self->SPLICE(1, 0, $value);
- } else {
- $self->{inc}[$index] = $value;
- }
+ $self->{body}[$index] = $value;
}
sub FETCHSIZE {
my ($self) = @_;
- return scalar @{$self->{inc}} + 1;
+ return scalar @{$self->{body}} + 1;
}
sub STORESIZE {
@@ -45,42 +40,42 @@ sub STORESIZE {
sub EXTEND {}
sub EXISTS {
my ($self, $index) = @_;
- return defined $self->{inc}[$index];
+ return defined $self->{body}[$index];
}
sub DELETE {
my ($self, $index) = @_;
- delete $self->{inc}[$index];
+ delete $self->{body}[$index];
}
sub CLEAR {
my ($self) = @_;
- $self->{inc} = [];
+ $self->{body} = [];
}
sub PUSH {
my ($self, @list) = @_;
- push @{$self->{inc}}, @list;
+ push @{$self->{body}}, @list;
}
sub POP {
my $self = shift;
- return pop @{$self->{inc}};
+ return pop @{$self->{body}};
}
sub SHIFT {
my $self = shift;
- return shift @{$self->{inc}};
+ return shift @{$self->{body}};
}
sub UNSHIFT {
my $self = shift;
- unshift @{$self->{inc}}, @_;
+ unshift @{$self->{body}}, @_;
}
sub SPLICE {
my $self = shift;
- splice @{$self->{inc}}, @_;
+ splice @{$self->{body}}, @_;
}
1;
View
2  lib/KingOfTheINC.pm
@@ -3,7 +3,7 @@ package KingOfTheINC;
use ForceToHead;
sub import {
- tie @INC, 'ForceToHead', \&tracker;
+ tie @INC, 'ForceToHead', \&tracker, @INC;
}
sub tracker {
View
26 t/force_to_head.t
@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+use ForceToHead;
+use Data::Dumper;
+
+my @array = (2..10);
+tie @array, 'ForceToHead', 'a', @array;
+
+unshift @array, 1;
+is_deeply( \@array, ['a',1..10] ) or warn Dumper [@array];
+
+shift @array;
+is_deeply( \@array, ['a',2..10]);
+
+push @array, 11;
+is_deeply( \@array, ['a',2..11]);
+
+pop @array;
+is_deeply( \@array, ['a',2..10]);
+
+splice @array, 0, 3;
+is_deeply( \@array, ['a',2..3] );

No commit comments for this range

Something went wrong with that request. Please try again.