The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

# Copyright 2008, 2009, 2010 Kevin Ryde

# This file is part of Chart.
#
# Chart is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 3, or (at your option) any later version.
#
# Chart is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along
# with Chart.  If not, see <http://www.gnu.org/licenses/>.

use locale;
use strict;
use warnings;
use List::Util;
use Data::Dumper;
use POSIX;
use Encode qw(:fallback_all);
use I18N::Langinfo qw(langinfo CODESET);

{
  require Data::Dumper;
  print Data::Dumper->new([\@INC],['@INC'])->Dump;

  print $INC{'App/Chart.pm'},"\n";

  require App::Chart;
  print App::Chart::datafilename('chart.xpm'),"\n";
  print App::Chart::datafilename('nosuchfile'),"\n";
  exit 0;
}

{
  require POSIX;
  print "numeric ", POSIX::setlocale(&POSIX::LC_NUMERIC),"\n";
  print "monetar ", POSIX::setlocale(&POSIX::LC_MONETARY),"\n";

  my $loc = POSIX::setlocale( &POSIX::LC_ALL); # , "el_GR" );
  print "Locale = $loc\n";
  my $lconv = POSIX::localeconv();
  print "decimal_point     = ", $lconv->{decimal_point},   "\n";
  print "thousands_sep     = ", $lconv->{thousands_sep},   "\n";
  print "grouping          = ", $lconv->{grouping},        "\n";
  print "int_curr_symbol   = ", $lconv->{int_curr_symbol}, "\n";
  print "currency_symbol   = ", $lconv->{currency_symbol}, "\n";
  print "mon_decimal_point = ", $lconv->{mon_decimal_point}, "\n";
  print "mon_thousands_sep = ", $lconv->{mon_thousands_sep}, "\n";
  print "mon_grouping      = ", $lconv->{mon_grouping},    "\n";
  print "positive_sign     = ", $lconv->{positive_sign},   "\n";
  print "negative_sign     = ", $lconv->{negative_sign},   "\n";
  print "int_frac_digits   = ", $lconv->{int_frac_digits}, "\n";
  print "frac_digits       = ", $lconv->{frac_digits},     "\n";
  print "p_cs_precedes     = ", $lconv->{p_cs_precedes},   "\n";
  print "p_sep_by_space    = ", $lconv->{p_sep_by_space},  "\n";
  print "n_cs_precedes     = ", $lconv->{n_cs_precedes},   "\n";
  print "n_sep_by_space    = ", $lconv->{n_sep_by_space},  "\n";
  print "p_sign_posn       = ", $lconv->{p_sign_posn},     "\n";
  print "n_sign_posn       = ", $lconv->{n_sign_posn},     "\n";

  require Number::Format;
  my $nf = Number::Format->new;
  print Dumper ($nf);
  print $nf->format_number (1235.56, 2, 1),"\n";

  require App::Chart;
  $nf = App::Chart::number_formatter();
  print $nf->format_number (1235.56, 2, 1),"\n";

  exit 0;
}

{
  my $p = \&print;
  open (my $fh, ">", "/dev/stdout") or die;
  $p->($fh,"hello") or die;
  exit 0;
}

{
  my $h = { x => 0};
  eval {
    local $h->{'x'} = 1;
    print $h->{'x'},"\n";
    die;
  };
  print $h->{'x'},"\n";
  exit 0;
}

{
  my @a;
  my $y = pop @a;
  print Dumper(\$y);
  exit 0;

  my $x = undef;
  print Dumper(\$x);
  print $x+0;
  print $^X,"
";
  print $0,"
";
  exit 0;
}
{
  my @a;
  my $x = \@a;
  my $y = \@a;
  print "$x $y\n";
  print $x+0," ",$y+0,"\n";
  exit 0;
}

# package ZZ;
# use strict;
# use warnings;
# use Data::Dumper;
# 
# sub new {
#   return bless {}, 'ZZ';
# }
# sub DESTROY {
#   my ($self) = @_;
#   print Dumper ($self);
#   print Dumper (\$main::x);
# }
# 
# package main;
# my $x = ZZ->new;
# Scalar::Util::weaken ($x);
# exit 0;



{
  open (my $fh, "/nosuchfile");
  my $err = "$!";
  print utf8::is_utf8($err)?"yes":"no","\n";
  print $!;
  exit 0;
}
{
  my $x = 'down';
  if (! $x) {
    print "yes\n";
  } else {
    print "no\n";
  }
  exit 0;
}
{
  my $x = '(?:\/|^)(?:CVS|.svn)\/';

  if ('xsvn/foo' =~ /$x/) {
    print "yes\n";
  } else {
    print "no\n";
  }
  exit 0;
}


{
  my $aref = ref (undef);
  print Dumper ($aref);
  exit 0;
}
{
  my $charset = langinfo (CODESET);
  print "charset $charset\n";

  foreach my $name (@Encode::FB_FLAGS) {
    my $value = eval "$name";
    printf "%-20s %#05X\n", $name, $value;
  }
  require PerlIO::encoding;
  local $PerlIO::encoding::fallback = 0; # FB_DEFAULT, substitute quietly
  local $PerlIO::encoding::fallback = Encode::PERLQQ;
  printf "fallback %#x\n",$PerlIO::encoding::fallback;

  binmode (STDOUT, ":encoding(latin-1)");
  my $str = "\b\x{263a}\n";
  print "len ", length($str),"\n";
  $| = 1;
  print $str;

  $str = "\r\r\r\n";
  print "len ", length($str),"\n";
  $| = 1;
  print $str;
  exit 0;
}

{
  my $loc = setlocale (LC_ALL);
  print "loc ", defined $loc ? $loc : 'undef', "\n";
  exit 0;
}



{
  my $x = \0;
  print Dumper ($x);
  exit 0;
}
#noop(1);
{
  my @a = ();
  my $r = \@a;
  print $r+0,"\n";
  push @a, ('x' x 10000);
  print $r+0,"\n";
  bless $r, ('x' x 100000);
  print $r+0,"\n";
  exit 0;
}
{
  my $x = 1;
  my $y = \$x;
  print $y->can('foo') ? 1 : 0;
  exit 0;
}
{
  my $aref = undef;
  print scalar $#$aref,"\n";
  print scalar @{$aref},"\n";
  print Dumper ($aref);
  exit 0;
}
{
  my $aref = undef;
  foreach (0 .. $#$aref) {
    print $#$aref;
  }
  exit 0;
}
{
  my $self = {};
  foreach my $a (@{$self->{'x'}}) {
    print 'x';
  }

  List::Util::first {print $_} @{$self->{'x'}};
  exit 0;
}

{
  my $ahash = undef;
  if (%$ahash) {
    print "yes\n";
  } else {
    print "no\n";
  }
  exit 0;
}

{
  print ref undef,"\n";

  print "argc=",scalar @ARGV,"\n";
  print "argv0=",$ARGV[0],"\n";
  print "argv1=",$ARGV[1],"\n";
  print "\$0=",$0,"\n";
  exit 0;
}

use Data::Dumper;
my %self = ();
my $self = \%self;
$self->{__PACKAGE__.'.y'} = 123;
print Dumper ($self);

my $sub = $self->{__PACKAGE__};
print Dumper ($sub);

{
  my @a = (undef);
  if ($a[0]->{'active'}) { print "hi\n";}
}
{
  my $a = undef;
  if ($a->{'active'}) { print "hi\n"; } else { print "bye\n";}
}

# use Glib;

# my $spec = Glib::ParamSpec->int ('name', 'nick', 'blurb', 99, 888, 150,
#                                  Glib::G_PARAM_READWRITE);
# print $spec->get_minimum;
# print $spec->get_maximum;
# exit 0;

# use Data::Dumper;
# use Set::IntSpan::Fast 1.10;
# {
#   use Set::Object::Weak;
#   my $set = Set::Object::Weak->new;

#   {
#     my $x = { 123 => 456 };
#     $set->insert ($x);
#     my @a = $set->members;
#     print Dumper (\@a);
#   }
  
#   my @a = $set->members;
#   print Dumper (\@a);
#   exit 0;
# }

# #my $x = undef;
# #bless $x,'Foo';

# if (0 eq undef) {
#   print "true\n";
# }

# {
#   my $ret = do 'undef.pl';
#   my $at = $@;
#   my $bang = $!;
#   print Dumper (\$at);
#   print Dumper (\$bang);
#   print Dumper (\$ret);
# }


# # eval