As Thick As Two Short Planks

System.out.println("Hello World");

say "Hello World"

sub log {
  no warnings;
  warn @_;
}

method log {
  no warnings;
  warn @_
}

bash$ sudo cpan Mini::CPAN

bash$ minicpan

bash$ perl -e 'print 235*1.15, "\n"'

bash$ perl -E 'say 235*1.15'

bash$ ssh me@remote "perl -MSomeModule -e 'print SomeModule->VERSION, qq{\n}"'

bash$ ssh me@remote "perl -MSomeModule -E 'say SomeModule->VERSION'"

use Test::Time::HiRes;  
use Time::HiRes qw(sleep);
sleep(3600 * 10);

use Test::More tests => 2;
use Test::Time::HiRes;

# Time::Hash::Expire uses Time::HiRes to get it's timing
use Tie::Hash::Expire;
tie my %hash, "Tie::Hash::Expire", { expire_seconds => 10 };
$hash{"foo"} = 1;

ok($hash{"foo"}, "key not expired");
time_travel_by(3600);
ok(!$hash{"foo"}, "key expired");

my $term = Term::ReadLine->new('report');
my $filename = $term->readline(
   "file to write output to? ",
   "$ENV{HOME}/report-".DateTime->now->ymd.".csv"
);

file to write output to? /Users/mark/report-2009-09-16.csv

bash$ http_proxy=http://127.0.0.1 lwp-request http://www.mywebsite.com

    foreach my $row (@{ $rows }) {
      say " * $row->{first_name} $row->{last_name}";
    }

bash$ perlthanks -r someone@example.com

This program provides an easy way to send a thank-you message
back to the authors and maintainers of perl.

If you wish to submit a bug report, please run it without the -T
flag (or run the program perlbug rather than perlthanks)

First of all, please provide a subject for the message.
Subject:

It's now time to compose your thank-you message.

Some information about your local perl configuration will
automatically be included at the end of your message, because
we're curious about the different ways that people build and use
perl. If you'd rather not share this information, you're welcome
to delete it.

You will probably want to use a text editor to enter the body of
your report. If "vi" is the editor you want to use, then just
press Enter, otherwise type in the name of the editor you would
like to use.

If you have already composed the body of your report, you may
enter "file", and /Users/mark/local/bin/perlthanks will prompt
you to enter the name of the file containing your report.

Editor [vi]: 

This is a thank-you report for perl from someone@example.com,
generated with the help of perlbug 1.39 running under perl 5.10.1.


-----------------------------------------------------------------
[Please enter your thank-you message here]



[You're welcome to delete anything below this line]
-----------------------------------------------------------------
---
Flags:
    category=thanks
    severity=none
---
Site configuration information for perl 5.10.1:

Configured by mark at Sun Aug  9 09:11:41 BST 2009.

Summary of my perl5 (revision 5 version 10 subversion 1) configuration:
...

package Test::EnhancedIs;
use base qw(Devel::UseFromCommandLineOnly);

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 1;
use Test::EnhancedIs;  # whooo, easier tests

use Sharks;
is(Sharks->armed,"frickin' laser beams");

bash$ perl test.t
1..1
Invalid use of Test::EnhancedIs in 'test.t' at line 7; This module can only be loaded from the command line at test.t line 7

travis-4:~ mark$ perl -MTest::EnhancedIs test.t 
1..1
not ok 1
#   Failed test at test.t line 9.
#          got: 'frickin' *sharp teeth'
#     expected: 'frickin' *laser beams'
# Looks like you failed 1 test of 1.

bash$ perl -Ilib t/01multi.t 
1..3
ok 1 - data okay
not ok 2 - ip
#   Failed test 'ip'
#   at t/01multi.t line 61.
#          got: '123.45.67.98'
#     expected: '123.45.67.89'
ok 3 - port
# Looks like you failed 1 test of 3.

travis-4:Babel-WideLog mark$ perl -MTest::EnhancedIs -Ilib t/01multi.t 
1..3
ok 1 - data okay
not ok 2 - ip
#   Failed test 'ip'
#   at t/01multi.t line 61.
#          got: '123.45.67.*98'
#     expected: '123.45.67.*89'
ok 3 - port
# Looks like you failed 1 test of 3.

package Test::EnhancedIs;
use base qw(Devel::UseFromCommandLineOnly);

use strict;
use warnings;
no warnings "redefine"; ## no critic (ProhibitNoWarnings)

our $VERSION = 0.00_01;

use Term::ANSIColor qw(colored);
use List::Util qw(min);

use Test::Builder;

# remember the original subroutine.  Note the BEGIN { } here - this is because
# without it this code will be run after the sub Test::Builder::_is_diag
# has been declared and we'll grab a ref to the wrong subroutine
my $uboat;
BEGIN { $uboat = \&Test::Builder::_is_diag }; ## no critic (ProtectPrivateVars)

# now write a new subroutine, overriding the subroutine in another package
# don't try this at home kids.
sub Test::Builder::_is_diag { ## no critic (ProtectPrivateSubs)
  my( $self, $got, $type, $expect ) = @_;

  # look for either a different character, or the end of either string
  my $index;
  foreach (0..min(length $got,length $expect)) {
    $index = $_;
    last if substr($got,$index,1) ne substr($expect,$index,1);
  }

  # put a marker in there
  substr($got,$index,0,colored("*","white on_red"));
  substr($expect,$index,0,colored("*","white on_red"));

  # run the original code
  return $uboat->($self,$got,$type,$expect);
}

1;

sub reset_password_from_email_token {
  my $self = shift;
  my $token = shift;
  my $password = shift;

  # temporarily disable security checks as this user isn't the one
  # the session is logged in as
  $self->disable_security_checks;

  if (any { $_ eq $token } $self->recent_reset_tokens) {
    $self->set_password($password);
    $self->remove_reset_token($token);
  }

  # turn the checks back on again
  $self->enable_security_checks;
 }

sub set_password {
  my $self = shift;
  my $value = shift;

  if (length($value) {value} = $value;
  return $self;
}

eval {
  $user->reset_password_from_email_token($token, $password);
};
if ($@) {
  if ($@ =~ /too short/) {
    return render_bad_password_page();
  } else { die $@ }
}
return render_password_reset_page();

sub reset_password_from_email_token {
  my $self = shift;
  my $token = shift;
  my $password = shift;

  # this user isn't the one the session is logged in as
  ...temporarily disable security checks somehow...

  if (any { $_ eq $token } $self->recent_reset_tokens) {
    $self->set_password($password);
    $self->remove_reset_token($token);
  }
}

sub reset_password_from_email_token {
  my $self = shift;
  my $token = shift;
  my $password = shift;

  # this user isn't the one the session is logged in as
  local $self->{security} = 0;

  if (any { $_ eq $token } $self->recent_reset_tokens) {
    $self->set_password($password);
    $self->remove_reset_token($token);
  }
}

use End qw(end);

sub reset_password_from_email_token {
  my $self = shift;
  my $token = shift;
  my $password = shift;

  # this user isn't the one the session is logged in as
  $self->disable_security_checks;
  my $temp = end { $self->enable_security_checks };

  if (any { $_ eq $token } $self->recent_reset_tokens) {
    $self->set_password($password);
    $self->remove_reset_token($token);
  }
}

sub reset_password_from_email_token {
  my $self = shift;
  my $token = shift;
  my $password = shift;

  # this user isn't the one the session is logged in as
  $self->temporarily_disable_security_checks;

  if (any { $_ eq $token } $self->recent_reset_tokens) {
    $self->set_password($password);
    $self->remove_reset_token($token);
  }
}

use Scope::Upper;

sub temporarily_disable_security_checks {
  my $self = shift;
  
  # disable security checks immediately
  $self->disable_security_checks;
  
  # and when the scope that called us exits, re-enable them
  reap sub {
    $self->enable_security_checks;
  }, UP;
}