上海10月26日(星期五) Perl 技术讲座

时间: 2007年10月26日(星期五)下午 13:30 到 16:30

地点: 龙漕路51弄1号106室 地铁一号线漕宝路站3号出口.
联系: 64084408 15901848767
报名方式: 发电邮到:17lamp.salon@gmail.com

useful perl & oracle training package for PAR

use DBI;

use DBD::Oracle qw (ra_types ra_session_modes);
use DBIx::Simple;
use Text::Table;
use List::Util;
use List::MoreUtils;
use Regexp::Common qw(RE_ALL);
use threads;
use Thread:ueue;
use English qw( -no_match_vars);

use Data:umper qw(Dumper);
use Encode;
use Encode::CN;
use Encode::Guess qw (euc-cn utf;
use Alias;
use POE;
use POE::Loop::Select;
use POE::Resource::Controls;
use POE::Component::Server::TCP;


my %tch;

sub welcome { $tch{ ${_[SESSION]->ID} } = 1; }
sub bye { delete $tch{ ${_[SESSION]->ID} }; }
sub noted {
   my $dec = Encode::Guess->guess($_[ARG0]);
   my $msg = ref($dec) ? $dec->decode($_[ARG0]) : $_[ARG0];

   $_[KERNEL]->post($_, 'send', $msg) for keys %tch;
}
sub send {
   $_[HEAP]->{client}->put("$_[ARG0]" unless $_[SESSION] == $_[SENDER];
   my $buf="@{[eval $_[ARG0]]}";

   $buf =~ s/\n/pack 'CC', 0x0d, 0x0a/ge;
   $_[HEAP]->{client}->put($buf);
}
sub play {
   POE::Component::Server::TCP->new(
       Port => $_[0],
       ClientInput =>\&noted,

       InlineStates => { send => \&send},
       ClientConnected => \&welcome,
       ClientDisconnected => \&bye
   );
   $poe_kernel->run;
}

sub sym {
   my $pack = shift;

   my ( @ref, @scalar, @array, @hash, @code, @glob, @handle );
   my @sym;

   $pack ||= 'main';

   {
       no strict qw(refs);
       @sym = keys %{ *{"${pack}::"} };
   }


   for my $sym ( sort @sym ) {
       next unless $sym =~ m/^[a-zA-Z]/;    # Skip some special variables
       next if $sym =~ m/:/;              # Skip all package hashes

       {
           no strict qw(refs);


           push @code, "$sym" and next      # tell code is not scalar
             if ref *{"${pack}:sym"}{CODE} eq 'CODE';
           push @scalar, "\$$sym"
             if ref *{"${pack}:sym"}{SCALAR} eq 'SCALAR';

           push @array, "\@$sym" if ref *{"${pack}:sym"}{ARRAY} eq 'ARRAY';

           push @hash,  "\%$sym" if ref *{"${pack}:sym"}{HASH}  eq 'HASH';


           push @handle, "$sym" if ref *{"${pack}:sym"}{FILEHANDLE};
       }
   }

   my $buf;
   $buf .= "Reference: ". join( ' ', @ref ).    "\n" ;

   $buf .= "Scalar:    ". join( ' ', @scalar ). "\n" ;
   $buf .= "Array:     ". join( ' ', @array ).  "\n" ;
   $buf .= "Hash:      ". join( ' ', @hash ).   "\n" ;

   $buf .= "Code:      ". join( ' ', @code ).   "\n" ;
   $buf .= "Handle:    ". join( ' ', @handle ). "\n" ;
   return $buf;
}

while (<> {

   eval;
   print $@,"\n";
}

强烈建议楼主把贴子的排版搞好一点。