def setUp(self): perl.eval(""" sub foo2 { wantarray ? (1, 2, 3) : 42; } """)
def t1(): global t1_done time.sleep(0.2) perl.eval("""print "Hello 1\n";""") time.sleep(0.7) perl.eval("""print "Hello 1 again\n";""") t1_done = 1
def test_pass_hashes_both_ways(self): # can we pass hashes both ways if perl.MULTI_PERL: self.skipTest("not on MULTI_PERL...") else: perl.eval("sub foo_elem { shift->{foo} }") hash = perl.eval("{ foo => 42 }") self.assertEqual(perl.call("foo_elem", hash), 42)
def test_trap_exceptions(self): # try to trap exceptions try: perl.eval("die 'Oops!'") except perl.PerlError as val: self.assertEqual(str(val)[:5],"Oops!") try: perl.call("not_there", 3, 4) except perl.PerlError as val: self.assertEqual(str(val), "Undefined subroutine &main::not_there called.\n")
def test_trap_exceptions(self): # try to trap exceptions try: perl.eval("die 'Oops!'") except perl.PerlError as val: self.assertEqual(str(val)[:5], "Oops!") try: perl.call("not_there", 3, 4) except perl.PerlError as val: self.assertEqual( str(val), "Undefined subroutine &main::not_there called.\n")
def t(start, step, stop): perl.eval(""" my($start, $step, $stop) = (%d,%d,%d); $| = 1; for (my $i = $start; $i <= $stop; $i += $step) { print "ok $i\n"; sleep(1); } """ % (start, step, stop))
def __init__(self, scriptfilename): self.scriptfilename = scriptfilename self.cleanname = clean(scriptfilename) scriptfile = file(scriptdir + scriptfilename, 'r') code = scriptfile.readlines() header = ['package %s;' % self.cleanname, \ 'sub %s {\n' % self.cleanname, \ '@ARGV = @_;\n'] footer = ['\n}', '1;'] wrappedAsFunction = header + code + footer self.scriptcode = '\n'.join(wrappedAsFunction) inc = perl.get_ref("@INC") inc.append(scriptdir) perl.eval(self.scriptcode) scriptfile.close()
def __init__(self, scriptfilename): self.scriptfilename = scriptfilename self.cleanname = clean(scriptfilename) scriptfile = file(scriptdir + scriptfilename,'r') code = scriptfile.readlines() header = ['package %s;' % self.cleanname, \ 'sub %s {\n' % self.cleanname, \ '@ARGV = @_;\n'] footer = ['\n}', '1;'] wrappedAsFunction = header + code + footer self.scriptcode = '\n'.join(wrappedAsFunction) inc = perl.get_ref("@INC") inc.append(scriptdir) perl.eval(self.scriptcode) scriptfile.close()
def __init__(self): """One instance of Globals is created during application initialization and is available during requests via the 'g' variable """ ispman_installdir = os.path.abspath(config['app_conf']['ispman_base_dir']) check_path_perms(ispman_installdir) try: import perl except ImportError: print "You need the pyperl module installed." print "You can get it from:" print " http://www.felix-schwarz.name/files/opensource/pyperl/" sys.exit(1) # Get Perl's @INC reference inc = perl.get_ref("@INC") # Add ISPMan lib directory to perl's @INC ispman_libs = os.path.join(ispman_installdir, 'lib') check_path_perms(ispman_libs) inc.append(ispman_libs) # Setup an ISPMan instance perl.require('ISPMan') perl.require('CGI') try: # Make ISPMan recognize us as a Control Panel self.ispman = perl.eval( '$ENV{"HTTP_USER_AGENT"} = "PYTHON-CCP"; ' + '$ispman = ISPMan->new() or die "$@"' ) except Exception, e: print e
def t1(): global perl_obj try: perl_obj.hello() print("not ") except ValueError as v: print("ok 1") #print v perl.eval("""sub Foo::DESTROY { $|=1; print "ok 4\n"; }"""); perl_obj = perl.get_ref("@") perl_obj.__class__ = "Foo"; #print perl_obj print("ok 3") sys.stdout.flush();
def t1(): global perl_obj try: perl_obj.hello() print("not ") except ValueError as v: print("ok 1") #print v perl.eval("""sub Foo::DESTROY { $|=1; print "ok 4\n"; }""") perl_obj = perl.get_ref("@") perl_obj.__class__ = "Foo" #print perl_obj print("ok 3") sys.stdout.flush()
def __init__(self): """One instance of Globals is created during application initialization and is available during requests via the 'g' variable. """ try: import perl except ImportError: print "You need the pyperl module installed." print "You can get it from the ISPManSOAP source" sys.exit(1) self.perl = perl log.debug('Perl Is Now Setup') ispman_installdir = os.path.abspath(config['app_conf']['ispman_base_dir']) # Get Perl's @INC reference inc = perl.get_ref("@INC") # Add ISPMan lib directory to perl's @INC ispman_libs = os.path.join(ispman_installdir, 'lib') inc.append(ispman_libs) # Setup an ISPMan instance perl.require('ISPMan') perl.require('CGI') try: ispman_perl = perl.eval( '$ENV{"HTTP_USER_AGENT"} = "PYTHON-CCP"; ' + '$ispman = ISPMan->new() or die "$@"' ) except Exception, e: print e
def test_anonymous_perl_functions(self): # can we call anonymous perl functions # can we pass hashes both ways if perl.MULTI_PERL: self.skipTest("not on MULTI_PERL...") else: func = perl.eval("sub { $_[0] + $_[1] }") self.assertEqual(int(func(3, 4)), 7)
def __init__(self, name): Processor.__init__(self, name) perl.eval('use lib "%s"' % self.knabdir) perl.require('Knab::Dumper') perl.require('Knab::Conf') perl.require('Knab::Modules') perl.require('Knab::Processor') perl.eval('$::dumper=new Knab::Dumper();') perl.eval('$::config = new Knab::Conf(Basedir=>"%s", Filename=>"%s");' % (self.knabdir, self.config)) factoidDB = perl.eval('$::config->getValue("FactoidDB/module");') perl.require(factoidDB) perl.eval('$::db=new %s();' % factoidDB) modules = perl.callm('new', 'Knab::Modules') self.processor = perl.callm('new', 'Knab::Processor', modules)
def __init__(self, name): Processor.__init__(self, name) perl.eval('use lib "%s"' % self.knabdir) perl.require('Knab::Dumper') perl.require('Knab::Conf') perl.require('Knab::Modules') perl.require('Knab::Processor') perl.eval('$::dumper=new Knab::Dumper();') perl.eval( '$::config = new Knab::Conf(Basedir=>"%s", Filename=>"%s");' % (self.knabdir, self.config)) factoidDB = perl.eval('$::config->getValue("FactoidDB/module");') perl.require(factoidDB) perl.eval('$::db=new %s();' % factoidDB) modules = perl.callm('new', 'Knab::Modules') self.processor = perl.callm('new', 'Knab::Processor', modules)
def __init__(self, dsn, user=None, password=None): global perl if not perl: import perl perl.require("DBI") conf = perl.get_ref("%") conf["RaiseError"] = 0 conf["PrintError"] = 0 conf["AutoCommit"] = 1 self.dbh = perl.callm("connect", "DBI", dsn, user, password, conf) if self.dbh is None: raise OperationalError, perl.eval("$DBI::errstr") self.dbh["RaiseError"] = 1 try: self.dbh["AutoCommit"] = 0 self.autocommit = 0 except: self.autocommit = 1
print "1..3" import perl import re perl.eval(""" #line 14 "safecall" #$^W = 1; require Opcode; sub compile { my($code) = @_; $code = "package main; sub do { " . $code . "}"; #print "[[$code]]\\n"; eval $code; die if $@; } sub foo { 42; } *Safe1::_compile = \&compile; """) mask = perl.call("Opcode::opset", "bless", "add") #print perl.call_tuple("Opcode::opset_to_ops", mask) perl.safecall("Safe1", mask, ('_compile', 'my $n = shift; print "ok $n\\n";')) perl.safecall("Safe1", mask, ('do', 1))
perl.eval(""" use Python qw(apply); $| = 1; sub { my $f = shift; # First some tests that are expected to blow up eval { apply($f); }; #print $@; # XXX For some strange reason =~ is not to force $@ to stingify, so # I had to help it with "$@" =~. # Hmmm, something to fix some other time :-( print "not " unless "$@" =~ /^python\.exceptions\.TypeError: not enough arguments/; print "ok 1\n"; eval { apply($f, undef); }; #print $@; print "not " unless "$@" =~ /^python\.exceptions\.TypeError: not enough arguments/; print "ok 2\n"; eval { apply($f, undef, undef); }; #print $@; print "not " unless "$@" =~ /^python\.exceptions\.TypeError: not enough arguments/; print "ok 3\n"; eval { apply($f, undef, undef, undef); }; #print $@; print "not " unless "$@" =~ /^Too many arguments at/; print "ok 4\n"; eval { apply($f, [1,2,3]); }; #print $@; print "not " unless "$@" =~ /^python.exceptions.TypeError: too many arguments/; print "ok 5\n"; eval { apply($f, [], {b => 2}); }; #print $@; print "not " unless "$@" =~ /^python.exceptions.TypeError: not enough arguments/; print "ok 6\n"; eval { apply($f, [1], {a => 2}); }; #print $@; print "not " unless "$@" =~ /^python.exceptions.TypeError: keyword parameter redefined/; print "ok 7\n"; eval { apply($f, [], {a => 2, b => 3, c => 4}); }; #print $@; print "not " unless "$@" =~ /^python.exceptions.TypeError: unexpected keyword argument: c/; print "ok 8\n"; eval { apply($f, 1); }; #print $@; print "not " unless "$@" =~ /^/; print "ok 9\n"; # Then some tests that are expected to work $res = apply($f, undef, { a => 101, b => 102 }); #print "$res\\n"; print "not " unless $res eq "a=101, b=102"; print "ok 10\n"; $res = apply($f, undef, { a => 101 }); #print "$res\\n"; print "not " unless $res eq "a=101, b=None"; print "ok 11\n"; $res = apply($f, [101, 102]); #print "$res\\n"; print "not " unless $res eq "a=101, b=102"; print "ok 12\n"; $res = apply($f, Python::list(101, 102), Python::dict()); #print "$res\\n"; print "not " unless $res eq "a=101, b=102"; print "ok 13\n"; $res = apply($f, [], Python::dict(a => 101)); #print "$res\\n"; print "not " unless $res eq "a=101, b=None"; print "ok 14\n"; } """)(ok)
import perl import sys perl.eval( """ my $sys = Python::Import("sys"); print "not " unless $sys->version eq "%s"; print "ok 1\n"; my $string = Python::Import("string"); print "not " unless $string->digits eq join("", 0..9); print "ok 2\n"; print "not " unless $string->lower("ABC") eq "abc"; print "ok 3\n"; eval { $fail = Python::Import("not_existing"); }; #print $@; print "not " unless Python::Err::ImportError($@) && $@ =~ /No module named/; print "ok 4\n"; """ % (sys.version) ) if sys.modules["string"]: print("ok 5")
perl.eval(""" # Test access to object from perl use Python qw(getattr hasattr setattr getitem); sub foo { my $foo = shift; print "$foo\n"; print "not " unless hasattr($foo, "plain") && getattr($foo, "plain") == 34; print "ok 1\n"; setattr($foo, plain => 42); print "not " unless getattr($foo, "plain") eq "42"; print "ok 2\n"; Python::delattr($foo, "plain"); print "not " unless Python::getattr($foo, "plain") eq "34"; print "ok 3\n"; print "not " unless $foo->plain eq 34; print "ok 4\n"; $foo->plain2(72); print "not " unless getattr($foo, "plain2") eq 72; print "ok 5\n"; print "not " unless $foo->plain2 eq 72; print "ok 6\n"; print "not " unless $foo->plain2("bar") eq 72 && $foo->plain2 eq "bar"; print "ok 7\n"; my $list = $foo->plain_list; print "not " unless Python::len($list) == 3 && getitem($list, 0) == 3; print "ok 8\n"; $list->append(0); print "not " unless Python::len($list) == 4 && $list->[-1] == 0; print "ok 9\n"; my @list = $foo->plain_list; print "not " unless "@list" eq "3 2 1 0"; print "ok 10\n"; # try method call $list = $foo->list; @list = $foo->list; print "not " unless "$list" eq "[1, 2, 3]" && "@list" eq "1 2 3"; print "ok 11\n"; # try access to non-existing attribute eval { $foo->not_there; }; print "not " unless $@ && Python::Err::AttributeError($@->type); print "ok 12\n"; # try calling something which is not callable eval { $foo->plain_list("foo", "bar"); }; print "not " unless $@ && $@ =~ /^Can't call a non-callable object/; print "ok 13\n"; # Strings are a sequences too, but they are not unwrapped. $foo->string("string"); @list = $foo->string; print "not " if "@list" ne "string"; print "ok 14\n"; } """)
def t2(): global t2_done time.sleep(0.75) # perl.eval("""print "Hello 2\n";""") perl.eval("""$a = "2";""") t2_done = 1 #perl.eval("time")
# This test that the embedded perl can load XS modules that happen # to be (usually) separate dynamic libraries. print("1..2") import perl addr = perl.eval(""" require Socket; Socket::pack_sockaddr_in(80, Socket::inet_aton('127.0.0.1')); """); #print repr(addr); if not addr: print("not ", end=' ') print("ok 1"); addr = perl.call_tuple("Socket::unpack_sockaddr_in", addr) #print addr if addr[0] != 80 or len(addr[1]) != 4: print("not ", end=' ') print("ok 2")
sys.exit(0) # This tests behaviour of perl objects passed from one # thread (and perl interpreter) to the next one and that # it is still destructed properly. print "1..5" perl_obj = perl.eval(""" sub Foo::hello { return "Hello"; } sub Foo::DESTROY { my $self = shift; print "ok 2\n"; } bless {}, "Foo"; """) #print perl_obj.hello(); #print perl_obj def t1(): global perl_obj try: perl_obj.hello()
print("1..3") import perl import re perl.eval(""" #line 14 "safecall" #$^W = 1; require Opcode; sub compile { my($code) = @_; $code = "package main; sub do { " . $code . "}"; #print "[[$code]]\\n"; eval $code; die if $@; } sub foo { 42; } *Safe1::_compile = \&compile; """) mask = perl.call("Opcode::opset", "bless", "add") #print perl.call_tuple("Opcode::opset_to_ops", mask) perl.safecall("Safe1", mask, ('_compile', 'my $n = shift; print "ok $n\\n";')) perl.safecall("Safe1", mask, ('do', 1))
import perl #if perl.MULTI_PERL: # print "1..0" # raise SystemExit print("1..11") perl.eval(""" sub foo { if (wantarray) { return "array"; } elsif (defined wantarray) { return "scalar"; } else { return; } } """) foo = perl.eval("\&foo") testno = 1 def expect(res, expect): global testno if res != expect:
# A basic thread test try: import thread except: print "1..0" import sys sys.exit(0) print "1..1" import time import perl perl.eval(""" $| = 1; $a = "0"; """) t1_done = 0 t2_done = 0 def t1(): global t1_done time.sleep(0.2) # perl.eval("""print "Hello 1\n";""") perl.eval("""$a = "1a";""") time.sleep(0.7) # perl.eval("""print "Hello 1 again\n";""") perl.eval("""$a = "1b";""") t1_done = 1
print("1..2") import perl perl.eval(""" Python::exec(" print 'ok 1' n = 4 "); print "ok ", Python::eval("n/2"), "\n"; """)
def eval(self, event, code): try: result = perl.eval(code) except Exception, e: result = e
f = perl.eval(""" #BEGIN{push @INC, 'd:\\vad\\perl-dev\\python\\pyperl3-1.0\\Python-Object\\blib\\lib'; } use blib "D:/vad/perl-dev/python/pyperl3-1.0/Python-Object/blib"; use Python qw(apply); use strict; print STDERR "b4 dict\\n"; my $d = Python::dict(foo=>42); print STDERR "a4 dict\\n"; $| = 1; my $ok = sub { print STDERR "[[@_]]\\n"; return "a=$_[0], b=$_[1]" }; sub { my $f = shift; print STDERR "xxxxx{f=$f}\\n"; eval{Python::PyEval_CallObjectWithKeywords($f);};print "{{$@}}\\n"; # First some tests that are expected to blow up eval { Python::PyEval_CallObjectWithKeywords(0,$f,$f,$f,$f,$f); apply($f); }; print "[[\$@=$@;]]\n"; # XXX For some strange reason =~ is not to force $@ to stingify, so # I had to help it with "$@" =~. # Hmmm, something to fix some other time :-( ) print "not " unless "$@" =~ /^python\.exceptions\.TypeError: not enough arguments/; print "ok 1\n"; eval { apply($f, undef); }; print $@; print "not " unless "$@" =~ /^python\.exceptions\.TypeError: not enough arguments/; print "ok 2\n"; eval { apply($f, undef, undef); }; print $@; print "not " unless "$@" =~ /^python\.exceptions\.TypeError: not enough arguments/; print "ok 3\n"; eval { apply($f, undef, undef, undef); }; #print $@; print "not " unless "$@" =~ /^Too many arguments at/; print "ok 4\n"; eval { apply($f, [1,2,3]); }; #print $@; print "not " unless "$@" =~ /^python.exceptions.TypeError: too many arguments/; print "ok 5\n"; eval { apply($f, [], {b => 2}); }; #print $@; print "not " unless "$@" =~ /^python.exceptions.TypeError: not enough arguments/; print "ok 6\n"; eval { apply($f, [1], {a => 2}); }; #print $@; print "not " unless "$@" =~ /^python.exceptions.TypeError: keyword parameter redefined/; print "ok 7\n"; eval { apply($f, [], {a => 2, b => 3, c => 4}); }; #print $@; print "not " unless "$@" =~ /^python.exceptions.TypeError: unexpected keyword argument: c/; print "ok 8\n"; eval { apply($f, 1); }; #print $@; print "not " unless "$@" =~ /^/; print "ok 9\n"; # Then some tests that are expected to work my $res = apply($f, undef, { a => 101, b => 102 }); #print "$res\\n"; print "not " unless $res eq "a=101, b=102"; print "ok 10\n"; $res = apply($f, undef, { a => 101 }); #print "$res\\n"; print "not " unless $res eq "a=101, b=None"; print "ok 11\n"; $res = apply($f, [101, 102]); #print "$res\\n"; print "not " unless $res eq "a=101, b=102"; print "ok 12\n"; $res = apply($f, Python::list(101, 102), Python::dict()); #print "$res\\n"; print "not " unless $res eq "a=101, b=102"; print "ok 13\n"; $res = apply($f, [], Python::dict(a => 101)); #print "$res\\n"; print "not " unless $res eq "a=101, b=None"; print "ok 14\n"; 'retto'; }; """)
sys.exit(0) # This tests behaviour of perl objects passed from one # thread (and perl interpreter) to the next one and that # it is still destructed properly. print "1..5" perl_obj = perl.eval(""" sub Foo::hello { return "Hello"; } sub Foo::DESTROY { my $self = shift; print "ok 2\n"; } bless {}, "Foo"; """) #print perl_obj.hello(); #print perl_obj def t1(): global perl_obj try:
def test_pass_strings_back(self): # can we pass strings back self.assertEqual(perl.eval("substr('abcd', 0, 3)"), "abc")
perl.eval(""" use Python qw(apply); $| = 1; sub { my $f = shift; # First some tests that are expected to blow up eval { apply($f); }; #print $@; # XXX For some strange reason =~ is not to force $@ to stingify, so # I had to help it with "$@" =~. # Hmmm, something to fix some other time :-( print "not " unless "$@" =~ /^python\.<type 'exceptions.TypeError'>: ok\(\) takes at least 1 argument \(0 given\)/; print "ok 1\n"; eval { apply($f, undef); }; #print $@; print "not " unless "$@" =~ /^python\.<type 'exceptions.TypeError'>: ok\(\) takes at least 1 argument \(0 given\)/; print "ok 2\n"; eval { apply($f, undef, undef); }; #print $@; print "not " unless "$@" =~ /^python\.<type 'exceptions.TypeError'>: ok\(\) takes at least 1 argument \(0 given\)/; print "ok 3\n"; eval { apply($f, undef, undef, undef); }; #print $@; print "not " unless "$@" =~ /^Too many arguments at \(eval 1\) line \d+./; print "ok 4\n"; eval { apply($f, [1,2,3]); }; #print $@; print "not " unless "$@" =~ /^python\.<type 'exceptions.TypeError'>: ok\(\) takes at most 2 arguments \(3 given\)/; print "ok 5\n"; eval { apply($f, [], {b => 2}); }; #print $@; print "not " unless "$@" =~ /^python\.<type 'exceptions.TypeError'>: ok\(\) takes at least 1 non-keyword argument \(0 given\)/; print "ok 6\n"; eval { apply($f, [1], {a => 2}); }; #print $@; print "not " unless "$@" =~ /^python\.<type 'exceptions.TypeError'>: ok\(\) got multiple values for keyword argument 'a'/; print "ok 7\n"; eval { apply($f, [], {a => 2, b => 3, c => 4}); }; #print $@; print "not " unless "$@" =~ /^python\.<type 'exceptions.TypeError'>: ok\(\) got an unexpected keyword argument 'c'/; print "ok 8\n"; eval { apply($f, 1); }; #print $@; print "not " unless "$@" =~ /^/; print "ok 9\n"; # Then some tests that are expected to work $res = apply($f, undef, { a => 101, b => 102 }); #print "$res\\n"; print "not " unless $res eq "a=101, b=102"; print "ok 10\n"; $res = apply($f, undef, { a => 101 }); #print "$res\\n"; print "not " unless $res eq "a=101, b=None"; print "ok 11\n"; $res = apply($f, [101, 102]); #print "$res\\n"; print "not " unless $res eq "a=101, b=102"; print "ok 12\n"; $res = apply($f, Python::list(101, 102), Python::dict()); #print "$res\\n"; print "not " unless $res eq "a=101, b=102"; print "ok 13\n"; $res = apply($f, [], Python::dict(a => 101)); #print "$res\\n"; print "not " unless $res eq "a=101, b=None"; print "ok 14\n"; } """)(ok)
def test_eval(self): self.assertEqual( perl.eval(""" Python::exec("print('ok 1'); n = 4"); Python::eval("n/2"); """), 2.0)
perl.eval(""" use Python qw(apply KW); $| = 1; sub foo { my $o = shift; eval { $o->foo(); }; #print $@; print "not " unless "$@" =~ /^python.exceptions.TypeError: not enough arguments/; print "ok 1\n"; my $res; # Test glob version $res = $o->foo(101); #print "$res\\n"; print "not " unless $res eq "a=101, b=None"; print "ok 2\n"; { package Foo::Bar; $res = $o->foo(*b => 102, *a => 101); #print "$res\\n"; print "not " unless $res eq "a=101, b=102"; print "ok 3\n"; } $res = $o->foo(101, *b => 102); #print "$res\\n"; print "not " unless $res eq "a=101, b=102"; print "ok 4\n"; # Test KW constructor $kw = KW(b => 102); $kw->{a} = 101; $res = $o->foo($kw); #print "$res\\n"; print "not " unless $res eq "a=101, b=102"; print "ok 5\n"; $res = $o->foo(KW(a => 101)); #print "$res\\n"; print "not " unless $res eq "a=101, b=None"; print "ok 6\n"; } """)
import perl #if perl.MULTI_PERL: # print "1..0" # raise SystemExit print "1..11" perl.eval(""" sub foo { if (wantarray) { return "array"; } elsif (defined wantarray) { return "scalar"; } else { return; } } """) foo = perl.eval("\&foo") testno = 1 def expect(res, expect): global testno if res != expect:
def test_eval(self): self.assertEqual(perl.eval(""" Python::exec("print('ok 1'); n = 4"); Python::eval("n/2"); """), 2.0);
# A basic thread test try: import thread except: print("1..0") import sys sys.exit(0) print("1..1") import time import perl perl.eval(""" $| = 1; $a = "0"; """) t1_done = 0 t2_done = 0 def t1(): global t1_done time.sleep(0.2) # perl.eval("""print "Hello 1\n";""") perl.eval("""$a = "1a";""") time.sleep(0.7) # perl.eval("""print "Hello 1 again\n";""") perl.eval("""$a = "1b";""") t1_done = 1
import copyreg copyreg.pickle(type(perl.get_ref("$")), perl_reduce, perl_restore) del (copy_reg) from pickle import dumps, loads # Make the dumps and loads functions available for perl f = perl.get_ref("$Python::Object::pickle_dumps", 1) f.__value__ = dumps f = perl.get_ref("$Python::Object::pickle_loads", 1) f.__value__ = loads del (f) perl.eval(""" package Python::Object; sub STORABLE_freeze { my($self, $cloning) = @_; return Python::funcall($pickle_dumps, $self, 1); } sub STORABLE_thaw { my($self, $cloning, $serialized) = @_; my $other = Python::funcall($pickle_loads, $serialized); Python::PyO_transplant($self, $other); return; } """)
print "1..8" import perl # try to use perl as a simple calculator if not perl.eval("3+3") == 6: print "not", print "ok 1" # can we pass strings back if not perl.eval("substr('abcd', 0, 3)") == "abc": print "not", print "ok 2" # can we pass hashes both ways if perl.MULTI_PERL: print "actually skipping test 3..." print "ok 3" else: perl.eval("sub foo_elem { shift->{foo} }") hash = perl.eval("{ foo => 42 }") if not perl.call("foo_elem", hash) == 42: print "not", print "ok 3" # try to trap exceptions try: perl.eval("die 'Oops!'") except perl.PerlError, val: if str(val)[:5] != "Oops!": print "not", print "ok 4" try:
print("1..5") import perl perl.eval(""" sub foo; sub bar { } @baz = (); $Foo::bar = 33; """) if perl.defined("baz") or perl.defined("baz"): print("not ", end=' ') print("ok 1") if not perl.defined("foo") and perl.defined("bar"): print("not ", end=' ') print("ok 2") if not perl.defined("@baz"): print("not ", end=' ') print("ok 3") if not perl.defined("$Foo::bar"): print("not ", end=' ') print("ok 4") try: if perl.defined(" $Foo::bar"): print("not ", end=' ') except perl.PerlError: print("ok 5")
raise SystemExit print "1..10" import thread import time def t(start, step, stop): perl.eval(""" my($start, $step, $stop) = (%d,%d,%d); $| = 1; for (my $i = $start; $i <= $stop; $i += $step) { print "ok $i\n"; sleep(1); } """ % (start, step, stop)) thread.start_new_thread(t, (1, 2, 9)) time.sleep(0.5) thread.start_new_thread(t, (2, 2, 10)) perl.eval("sleep 3") print "perl sleep done" time.sleep(4) print "done"
if not perl.MULTI_PERL: print("1..0") raise SystemExit print("1..10") import thread import time def t(start, step, stop): perl.eval(""" my($start, $step, $stop) = (%d,%d,%d); $| = 1; for (my $i = $start; $i <= $stop; $i += $step) { print "ok $i\n"; sleep(1); } """ % (start, step, stop)) thread.start_new_thread(t, (1, 2, 9)) time.sleep(0.5) thread.start_new_thread(t, (2, 2, 10)) perl.eval("sleep 3") #print "perl sleep done" time.sleep(4) #print "done"
import perl import sys print "1..4" perl.eval("use lib 't'") # good when running from .. perl.eval("use TestClass") try: obj = perl.callm("new", "NotAClass") except perl.PerlError, v: expect = "Can't locate object method \"new\" via package \"NotAClass\"" if str(v)[:len(expect)] != expect: print "not", print "ok 1" obj = perl.callm("new", "TestClass") try: obj.not_a_method(34, 33); except perl.PerlError, v: if str(v) != "Can't locate object method \"not_a_method\" via package \"TestClass\".\n": print "not", print "ok 2" except AttributeError: if not perl.MULTI_PERL: print "not", print "ok 2" try: obj.error("foo");
# This test that the embedded perl can load XS modules that happen # to be (usually) separate dynamic libraries. print "1..2" import perl addr = perl.eval(""" require Socket; Socket::pack_sockaddr_in(80, Socket::inet_aton('127.0.0.1')); """) #print repr(addr); if not addr: print "not ", print "ok 1" addr = perl.call_tuple("Socket::unpack_sockaddr_in", addr) #print addr if addr[0] != 80 or len(addr[1]) != 4: print "not ", print "ok 2"
# A basic thread test try: import thread except: print "1..0" import sys sys.exit(0) print "1..1" import time import perl perl.eval(""" $| = 1; print "Hello 0\n"; """) t1_done = 0 t2_done = 0 def t1(): global t1_done time.sleep(0.2) perl.eval("""print "Hello 1\n";""") time.sleep(0.7) perl.eval("""print "Hello 1 again\n";""") t1_done = 1 def t2(): global t2_done
def __init__(self, config, arch, media, includelist, excludelist, rpmsrate, compssusers, filedeps, suggests = False, synthfilter = ".cz:gzip -9", root="/usr/lib64/drakx-installer/root", stage1=None, stage2=None, advertising=None, gpgName=None, gpgPass=None): volumeid = ("%s-%s-%s-%s" % (config.vendor, config.product, config.version, arch)).upper() if len(volumeid) > 32: print("length of volumeid '%s' (%d) > 32" % (volumeid, len(volumeid))) exit(1) self.arch = arch self.media = {} for m in media: self.media[m.name] = m tmpdir = config.tmpdir+"/"+arch repopath = config.repopath+"/"+self.arch config.rootdir = root print(color("Parsing lists of packages to include", GREEN)) includes = [] for pkglf in includelist: f = open(pkglf) for line in f.readlines(): line = line.strip() if not line or line[0] == "#": continue if line.startswith("CAT_"): category, weight = line.split() pkgs = self.get_list_from_CAT(rpmsrate, category, weight) includes.extend(pkgs) else: includes.append(line) f.close() print(color("Parsing lists of packages to exclude", GREEN)) excludepattern = "" excludes = [] for exclf in excludelist: f = open(exclf) for line in f.readlines(): line = line.strip() if line and line[0] != '#': excludes.append(line) if excludepattern: excludepattern += '|' if line[0] == '^' or line[-1] == '$': excludepattern += line else: excludepattern += fnmatch.translate(line).replace("\\Z","") f.close() excludere = re.compile(excludepattern) empty_db = perl.callm("new", "URPM") urpm = perl.eval("""my $urpm = urpm->new();""" """$urpm->{error} = sub { printf "urpm error: %s\n", $_[0] };""" """$urpm->{fatal} = sub { printf "urpm fatal %s\n", $_[0]; };""" # enable for urpm debug output #"""$urpm->{log} = sub { printf "urpm log: %s\n", $_[0] };""" #"""$urpm->{debug} = sub { printf "urpm debug: %s\n", $_[0] };""" #"""$urpm->{debug_URPM} = sub { printf "URPM debug: %s\n", $_[0] };""" "$urpm;") for m in list(self.media.keys()): synthesis = repopath + "/" + self.media[m].getSynthesis() print(color("Parsing synthesis for %s: %s" % (m, synthesis), GREEN)) urpm.parse_synthesis(synthesis) updates = repopath + "/" + self.media[m].getSynthesis("updates") if os.path.exists(updates): print(color("Parsing updates synthesis for %s: %s" % (m, synthesis), GREEN)) urpm.parse_synthesis(updates) perlexc = perl.eval("@excludes = ();") perlexc = perl.get_ref("@excludes") perlexc.extend(excludes) stop_on_choices = perl.eval("""$stop_on_choices = sub { my ($urpm, undef, $state_, $choices, $virtual_pkg_name, $preferred) = @_; my $dep; foreach my $pkg (@$choices) { print "\033[0mchoice($virtual_pkg_name): " . $pkg->fullname(); if (grep { $_ eq $pkg->name() } @excludes) { print ": \033[33m\033[49m\033[2mexcluded\n"; next; } if (!$dep) { print ": \033[33m\033[49m\033[1mincluding\n"; $dep = $pkg; } elsif (!$dep->compare_pkg($pkg)) { print ": \033[33m\033[49m\033[1mpreferred over " . $dep->fullname() . "\n"; $dep = $pkg; } else { print ": \033[33m\033[49m\033[2mskipped in favour of " . $dep->fullname() . "\n"; } } print "\033[0m"; if (defined($dep)) { $state_->{selected}{$dep->id} = 1; } else { print "choice($virtual_pkg_name): \033[33m\033[49m\033[2mnone chosen!\n"; } }""") def search_pkgs(deps): requested = dict() state = perl.get_ref("%") perl.call("urpm::select::search_packages", urpm, requested, deps, use_provides=1) # create a dictionary of URPM::Package objects, indexed by fullname # for us to easier lookup packages in pkgdict = dict() for key in list(requested.keys()): if not key: requested.pop(key) continue pkgids = key.split("|") if not pkgids: continue dep = None for pkgid in pkgids: pkg = urpm['depslist'][int(pkgid)] if excludere.match(pkg.name()): requested.pop(key) print(color("skipping candidate for requested packages: %s" % pkg.fullname(), YELLOW)) break if not dep: dep = pkg elif dep.compare_pkg(pkg) < 0: dep = pkg if dep: if len(pkgids) > 1: # XXX if key in requested: requested.pop(key) requested[str(dep.id())] = 1 pkgdict[pkg.fullname()] = dep urpm.resolve_requested(empty_db, state, requested, no_suggests = not suggests, callback_choices = stop_on_choices, nodeps = 1) allpkgs = [] # As we try resolving all packages we'd like to include in the distribution # release at once, there's a fair chance of there being some requested # packages conflicting with eachother, resulting in requested packages # getting rejected. To workaround this, we'll try resolve these packages # separately to still include them and their dependencies. rejects = [] for key in list(state['rejected'].keys()): reject = state['rejected'][key] #print color("rejected: %s" % key, RED, RESET, DIM) # FIXME: #if 'backtrack' in reject: if reject.has_key('backtrack'): backtrack = reject['backtrack'] #if 'conflicts' in backtrack: if backtrack.has_key('conflicts'): if key in pkgdict: pkg = pkgdict[key] print(color("conflicts: %s with %s" % (key, list(backtrack['conflicts'])), RED, RESET, DIM)) if pkg.name() in deps and pkg.name() not in rejects: conflicts = backtrack['conflicts'] skip = False for c in conflicts: # XXX if c in pkgdict: cpkg = pkgdict[c] # if it's a package rejected due to conflict with a package of same name, # it's most likely some leftover package in repos that haven't been # removed yet and that we can safely ignore if cpkg.name() == pkg.name(): skip = True else: skip = True if not skip: print(color("The requested package %s has been rejected due to conflicts with: %s" % (pkg.fullname(), string.join(conflicts)), RED, RESET, BRIGHT)) rejects.append(pkg.name()) if rejects: print(color("Trying to resolve the following requested packages rejected due to conflicts: %s" % string.join(rejects, " "), BLUE, RESET, BRIGHT)) res = search_pkgs(rejects) for pkg in res: pkgid = str(pkg.id()) if not pkgid in list(state['selected'].keys()): print(color("adding %s" % pkg.fullname(), BLUE)) state['selected'][pkgid] = 1 for pkgid in list(state['selected'].keys()): pkgids = pkgid.split('|') dep = None for pkgid in pkgids: pkgid = int(pkgid) pkg = urpm['depslist'][pkgid] if excludere.match(pkg.name()): print(color("skipping1: %s" % pkg.fullname(), YELLOW, RESET, DIM)) continue #else: # print color("including1: %s" % pkg.fullname(), YELLOW, RESET, BRIGHT) if not dep: dep = pkg else: print(color("hum: %s" % pkg.fullname(), YELLOW, RESET, DIM)) True if dep is None: print(color("dep is none: %s" % pkg.fullname(), YELLOW, RESET, DIM)) continue else: #print color("including: %s" % pkg.fullname(), YELLOW, RESET, BRIGHT) allpkgs.append(dep) return allpkgs print(color("Resolving packages", GREEN)) allpkgs = search_pkgs(includes) # we allow to search through all matches regardless of being able to satisfy # dependencies, for in which case urpmi doesn't check which to prefer in case # several versions of same package is found, urpmi just picks first returned, # so we need to do a second run to make sure that we actually get the right ones includes = [] for p in allpkgs: includes.append(p.name()) allpkgs = search_pkgs(includes) print(color("Initiating distribution tree", GREEN)) smartopts = "channel -o sync-urpmi-medialist=no --data-dir smartdata" os.system("rm -rf " + tmpdir) os.system("rm -rf smartdata") os.mkdir("smartdata") os.system("mkdir -p %s/media/media_info/" % tmpdir) shutil.copy(compssusers, "%s/media/media_info/compssUsers.pl" % tmpdir) shutil.copy(filedeps, "%s/media/media_info/file-deps" % tmpdir) rootfiles = ['COPYING', 'index.htm', 'install.htm', 'INSTALL.txt', 'LICENSE-APPS.txt', 'LICENSE.txt', 'README.txt', 'release-notes.html', 'release-notes.txt', 'doc', 'misc'] for f in rootfiles: os.symlink("%s/%s" % (repopath, f), "%s/%s" % (tmpdir, f)) f = open(tmpdir+"/product.id", "w") # unsure about relevance of all these fields, will just hardcode those seeming irrelevant for now.. f.write("vendor=%s,distribution=%s,type=basic,version=%s,branch=%s,release=1,arch=%s,product=%s\n" % (config.vendor,config.distribution,config.version,config.branch,arch,config.product)) f.close() ext = synthfilter.split(":")[0] for m in media: print(color("Generating media tree for " + m.name, GREEN)) os.system("mkdir -p %s/media/%s" % (tmpdir, m.name)) pkgs = [] for pkg in allpkgs: if excludere.match(pkg.name()): print(color("skipping2: " + pkg.name(), YELLOW, RESET, DIM)) continue for rep in "release", "updates": source = "%s/media/%s/%s/%s.rpm" % (repopath, m.name, rep, pkg.fullname()) if os.path.exists(source): target = "%s/media/%s/%s.rpm" % (tmpdir, m.name, pkg.fullname()) if not os.path.islink(target): pkgs.append(source) os.symlink(source, target) s = os.stat(source) m.size += s.st_size self.media[m.name].pkgs = pkgs if not os.path.exists("%s/media/%s/media_info" % (tmpdir, m.name)): os.mkdir("%s/media/%s/media_info" % (tmpdir, m.name)) if gpgName: #signPackage(gpgName, gpgPass, " ".join(pkgs)) os.system("gpg --export --armor %s > %s/media/%s/media_info/pubkey" % (gpgName, tmpdir, m.name)) print(color("Writing %s/media/media_info/media.cfg" % tmpdir, GREEN)) if not os.path.exists("%s/media/media_info" % tmpdir): os.mkdir("%s/media/media_info" % tmpdir) mediaCfg = \ "[media_info]\n" \ "mediacfg_version=2\n" \ "version=%s\n" \ "branch=%s\n" \ "product=%s\n" \ "arch=%s\n" \ "synthesis-filter=%s\n" \ "xml-info=1\n" \ "xml-info-filter=.lzma:lzma --text\n" % (config.version, config.branch, config.product, self.arch, synthfilter) for m in media: mediaCfg += m.getCfgEntry(ext=ext) f = open("%s/media/media_info/media.cfg" % tmpdir, "w") f.write(mediaCfg) f.close() os.system("gendistrib "+tmpdir) os.system("rm %s/media/media_info/{MD5SUM,*.cz}" % tmpdir) for m in media: # workaround for urpmi spaghetti code which hardcodes .cz if ext != ".cz": os.symlink("synthesis.hdlist%s" % ext, "%s/media/%s/media_info/synthesis.hdlist.cz" % (tmpdir, m.name)) os.unlink("%s/media/%s/media_info/hdlist.cz" % (tmpdir, m.name)) os.system("cd %s/media/%s/media_info/; md5sum * > MD5SUM" % (tmpdir, m.name)) smartopts = "-o sync-urpmi-medialist=no --data-dir %s/smartdata" % os.getenv("PWD") os.system("smart channel --yes %s --add %s type=urpmi baseurl=%s/media/%s/ hdlurl=media_info/synthesis.hdlist%s" % (smartopts, m.name, tmpdir, m.name, ext)) print(color("Checking packages", GREEN)) rpmdirs = [] for m in list(self.media.keys()): rpmdirs.append("%s/media/%s" % (tmpdir, m)) os.system("smart update %s" % smartopts) os.system("smart check %s --channels=%s" % (smartopts, string.join(list(self.media.keys()),","))) os.system("sleep 5"); print(color("Generating %s/media/media_info/rpmsrate" % tmpdir, GREEN)) # TODO: reimplement clean-rpmsrate in python(?) # can probably replace much of it's functionality with meta packages os.system("clean-rpmsrate -o %s/media/media_info/rpmsrate %s %s" % (tmpdir, rpmsrate, string.join(rpmdirs," "))) if not os.path.exists("%s/media/media_info/rpmsrate" % tmpdir): print("error in rpmsrate") exit(1) # if none specified, rely on it's presence in grub target tree... if not stage1: stage1 = "%s/grub/%s/install/images/all.cpio.xz" % (config.rootdir, self.arch) print(color("Copying first stage installer: %s -> %s/install/images/all.cpio.xz" % (stage1, tmpdir), GREEN)) os.mkdir("%s/install" % tmpdir) os.mkdir("%s/install/images" % tmpdir) os.symlink(os.path.realpath(stage1), tmpdir + "/install/images/all.cpio.xz") if not stage2: stage2 = os.path.realpath(config.rootdir) + "/install/stage2/mdkinst.cpio.xz" versionFile = os.path.realpath(config.rootdir) + "/install/stage2/VERSION" print(color("Copying second stage installer: %s -> %s/install/stage2/mdkinst.cpio.xz" % (stage2, tmpdir), GREEN)) os.mkdir(tmpdir + "/install/stage2") os.symlink(stage2, tmpdir + "/install/stage2/mdkinst.cpio.xz") os.symlink(versionFile, tmpdir + "/install/stage2/VERSION") if not advertising: advertising="%s/install/extra/advertising" % config.rootdir print(color("Copying advertising: %s -> %s/install/extra/advertising" % (advertising, tmpdir), GREEN)) os.mkdir("%s/install/extra" % tmpdir) os.symlink(os.path.realpath(advertising), tmpdir + "/install/extra/advertising") print(color("Generating %s/media/media_info/MD5SUM" % tmpdir, GREEN)) os.system("cd %s/media/media_info/; md5sum * > MD5SUM" % tmpdir) self.pkgs = [] def get_pkgs(pkg): self.pkgs.append("%s-%s (%s)" % (pkg.name(), pkg.version(), pkg.arch())) urpm.traverse(get_pkgs) self.pkgs.sort() idxfile = open("%s/pkg-%s-%s-%s.idx" % (tmpdir, config.version, config.subversion.replace(" ","").lower(),config.codename.replace(" ","-").lower()), "w") for pkg in self.pkgs: idxfile.write(pkg+"\n") idxfile.close()
def setUp(self): perl.eval( """sub foo;""" """sub bar { }""" """@baz = ();""" """$Foo::bar = 33;""")
def test_simple_calculator(self): # try to use perl as a simple calculator self.assertEqual(perl.eval("3+3"), 6)