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

10月26日(星期五) Perl 技术讲座
时间: 2007年10月26日(星期五)下午 13:30 到 16:30
地点: 龙漕路51弄1号106室 地铁一号线漕宝路站3号出口.
联系: 64084408 15901848767
报名方式: 发电邮到:17lamp.salon@gmail.com
主讲人 Joe.

useful perl & oracle training package for PAR


use DBI;use DBD::Oracle qw (:ora_types :ora_session_modes);use DBIx::Simple;use Text::Table;use List::Util;use List::MoreUtils;use Regexp::Common qw(RE_ALL);use threads;use Thread::Queue;
use English qw( -no_match_vars);use Data::Dumper qw(Dumper);use Encode;use Encode::CN;use Encode::Guess qw (euc-cn utf8);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";}