From 36477c247f3c188fb8cc7e276c87b739d3e6ab7c Mon Sep 17 00:00:00 2001 From: Perl 5 Porters Date: Fri, 6 Dec 1996 18:56:00 +1200 Subject: [PATCH] [inseparable changes from patch from perl5.003_10 to perl5.003_11] CORE LANGUAGE CHANGES Subject: Fix precedence problems with subs as uniops or listops From: Chip Salzenberg Files: perly.c perly.c.diff perly.h perly.y Subject: Don't reset $. on open() From: Chip Salzenberg Files: pp_sys.c Subject: Support *glob{IO} (eventually deprecate *glob{FILEHANDLE}) From: Chip Salzenberg Files: pod/perlref.pod pp_hot.c sv.c Subject: Don't let expression context force return context From: Chip Salzenberg Files: op.c Subject: Properly convert "1E2" et al to IV/UV From: Chip Salzenberg Files: doio.c sv.c Subject: Fix modulo operator in UV realm From: Chip Salzenberg Files: pp.c Subject: Fix stat(_) after stat(HANDLE) From: Chip Salzenberg Files: pp_sys.c Subject: Fix: s/// and "$x =~ $y" under 'use locale' From: Chip Salzenberg Files: op.c toke.c LIBRARY AND EXTENSIONS Subject: {in,ob}structive pods Date: Sat, 30 Nov 1996 09:52:57 -0700 From: Tom Christiansen Files: MANIFEST lib/Class/Template.pm lib/File/stat.pm lib/Net/hostent.pm lib/Net/netent.pm lib/Net/protoent.pm lib/Net/servent.pm lib/Time/gmtime.pm lib/Time/localtime.pm lib/Time/tm.pm lib/User/grent.pm lib/User/pwent.pm These "should" be ready for inclusion in 5.004, although I'd like to update Class::Template's doc for legibility. Dean, may we please have your permission to include this in the distribution? (I did look a bit into using Class::MethodMaker, but it seemed a bit complicated.) I know: these all look remarkably similar on the inside. I keep trying to find a way to abstract out some of it. Hopefully, they're reasonably legible at least in code, if not in docs. :-) Chip/Tim, please check the stat function for proper use of Symbol. thanks, --tom #!/bin/sh # This is a shell archive (produced by GNU sharutils 4.2). # To extract the files from this archive, save it to some FILE, remove # everything before the `!/bin/sh' line above, then type `sh FILE'. # # Made on 1996-11-30 09:52 MST by . # Source directory was `/home/tchrist/hack'. # # Existing files will *not* be overwritten unless `-c' is specified. # # This shar contains: # length mode name # ------ ---------- ------------------------------------------ # 5024 -rw-r--r-- obstructs/Class/Template.pm # 2782 -rw-r--r-- obstructs/File/stat.pm # 3961 -rw-r--r-- obstructs/Net/hostent.pm # 4435 -rw-r--r-- obstructs/Net/netent.pm # 2973 -rw-r--r-- obstructs/Net/protoent.pm # 3424 -rw-r--r-- obstructs/Net/servent.pm # 2476 -rw-r--r-- obstructs/Time/gmtime.pm # 2307 -rw-r--r-- obstructs/Time/localtime.pm # 622 -rw-r--r-- obstructs/Time/tm.pm # 2848 -rw-r--r-- obstructs/User/grent.pm # 2899 -rw-r--r-- obstructs/User/pwent.pm # save_IFS="${IFS}" IFS="${IFS}:" gettext_dir=FAILED locale_dir=FAILED first_param="$1" for dir in $PATH do if test "$gettext_dir" = FAILED && test -f $dir/gettext \ && ($dir/gettext --version >/dev/null 2>&1) then set `$dir/gettext --version 2>&1` if test "$3" = GNU then gettext_dir=$dir fi fi if test "$locale_dir" = FAILED && test -f $dir/shar \ && ($dir/shar --print-text-domain-dir >/dev/null 2>&1) then locale_dir=`$dir/shar --print-text-domain-dir` fi done IFS="$save_IFS" if test "$locale_dir" = FAILED || test "$gettext_dir" = FAILED then echo=echo else TEXTDOMAINDIR=$locale_dir export TEXTDOMAINDIR TEXTDOMAIN=sharutils export TEXTDOMAIN echo="$gettext_dir/gettext -s" fi touch -am 1231235999 $$.touch >/dev/null 2>&1 if test ! -f 1231235999 && test -f $$.touch; then shar_touch=touch else shar_touch=: echo $echo 'WARNING: not restoring timestamps. Consider getting and' $echo "installing GNU \`touch', distributed in GNU File Utilities..." echo fi rm -f 1231235999 $$.touch # if mkdir _sh24166; then $echo 'x -' 'creating lock directory' else $echo 'failed to create lock directory' exit 1 fi # ============= obstructs/Class/Template.pm ============== if test ! -d 'obstructs'; then $echo 'x -' 'creating directory' 'obstructs' mkdir 'obstructs' fi if test ! -d 'obstructs/Class'; then $echo 'x -' 'creating directory' 'obstructs/Class' mkdir 'obstructs/Class' fi if test -f 'obstructs/Class/Template.pm' && test "$first_param" != -c; then $echo 'x -' SKIPPING 'obstructs/Class/Template.pm' '(file already exists)' else $echo 'x -' extracting 'obstructs/Class/Template.pm' '(text)' sed 's/^X//' << 'SHAR_EOF' > 'obstructs/Class/Template.pm' && package Class::Template; require 5.000; require Exporter; X @ISA = qw(Exporter); @EXPORT = qw(members struct); use strict; X # Template.pm --- struct/member template builder # 12mar95 # Dean Roehrich # # changes/bugs fixed since 28nov94 version: # - podified # changes/bugs fixed since 21nov94 version: # - Fixed examples. # changes/bugs fixed since 02sep94 version: # - Moved to Class::Template. # changes/bugs fixed since 20feb94 version: # - Updated to be a more proper module. # - Added "use strict". # - Bug in build_methods, was using @var when @$var needed. # - Now using my() rather than local(). # # Uses perl5 classes to create nested data types. # This is offered as one implementation of Tom Christiansen's "structs.pl" # idea. X =head1 NAME X Class::Template - struct/member template builder X =head1 EXAMPLES X =item * Example 1 X X use Class::Template; X X struct( rusage => { X ru_utime => timeval, X ru_stime => timeval, X }); X X struct( timeval => [ X tv_secs => '$', X tv_usecs => '$', X ]); X X my $s = new rusage; X =item * Example 2 X X package OBJ; X use Class::Template; X X members OBJ { X 'a' => '$', X 'b' => '$', X }; X X members OBJ2 { X 'd' => '@', X 'c' => '$', X }; X X package OBJ2; @ISA = (OBJ); X X sub new { X my $r = InitMembers( &OBJ::InitMembers() ); X bless $r; X } X =head1 NOTES X Use '%' if the member should point to an anonymous hash. Use '@' if the member should point to an anonymous array. X When using % and @ the method requires one argument for the key or index into the hash or array. X Prefix the %, @, or $ with '*' to indicate you want to retrieve pointers to the values rather than the values themselves. X =cut X Var: { X $Class::Template::print = 0; X sub printem { $Class::Template::print++ } } X X sub struct { X my( $struct, $ref ) = @_; X my @methods = (); X my %refs = (); X my %arrays = (); X my %hashes = (); X my $out = ''; X X $out = "{\n package $struct;\n sub new {\n"; X parse_fields( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes, 0 ); X $out .= " bless \$r;\n }\n"; X build_methods( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes ); X $out .= "}\n1;\n"; X X ( $Class::Template::print ) ? print( $out ) : eval $out; } X sub members { X my( $pkg, $ref ) = @_; X my @methods = (); X my %refs = (); X my %arrays = (); X my %hashes = (); X my $out = ''; X X $out = "{\n package $pkg;\n sub InitMembers {\n"; X parse_fields( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes, 1 ); X $out .= " bless \$r;\n }\n"; X build_methods( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes ); X $out .= "}\n1;\n"; X X ( $Class::Template::print ) ? print( $out ) : eval $out; } X X sub parse_fields { X my( $ref, $out, $methods, $refs, $arrays, $hashes, $member ) = @_; X my $type = ref $ref; X my @keys; X my $val; X my $cnt = 0; X my $idx = 0; X my( $cmt, $n ); X X if( $type eq 'HASH' ){ X if( $member ){ X $$out .= " my(\$r) = \@_ ? shift : {};\n"; X } X else{ X $$out .= " my(\$r) = {};\n"; X } X @keys = keys %$ref; X foreach (@keys){ X $val = $ref->{$_}; X if( $val =~ /^\*(.)/ ){ X $refs->{$_}++; X $val = $1; X } X if( $val eq '@' ){ X $$out .= " \$r->{'$_'} = [];\n"; X $arrays->{$_}++; X } X elsif( $val eq '%' ){ X $$out .= " \$r->{'$_'} = {};\n"; X $hashes->{$_}++; X } X elsif( $val ne '$' ){ X $$out .= " \$r->{'$_'} = \&${val}::new();\n"; X } X else{ X $$out .= " \$r->{'$_'} = undef;\n"; X } X push( @$methods, $_ ); X } X } X elsif( $type eq 'ARRAY' ){ X if( $member ){ X $$out .= " my(\$r) = \@_ ? shift : [];\n"; X } X else{ X $$out .= " my(\$r) = [];\n"; X } X while( $idx < @$ref ){ X $n = $ref->[$idx]; X push( @$methods, $n ); X $val = $ref->[$idx+1]; X $cmt = "# $n"; X if( $val =~ /^\*(.)/ ){ X $refs->{$n}++; X $val = $1; X } X if( $val eq '@' ){ X $$out .= " \$r->[$cnt] = []; $cmt\n"; X $arrays->{$n}++; X } X elsif( $val eq '%' ){ X $$out .= " \$r->[$cnt] = {}; $cmt\n"; X $hashes->{$n}++; X } X elsif( $val ne '$' ){ X $$out .= " \$r->[$cnt] = \&${val}::new();\n"; X } X else{ X $$out .= " \$r->[$cnt] = undef; $cmt\n"; X } X ++$cnt; X $idx += 2; X } X } } X X sub build_methods { X my( $ref, $out, $methods, $refs, $arrays, $hashes ) = @_; X my $type = ref $ref; X my $elem = ''; X my $cnt = 0; X my( $pre, $pst, $cmt, $idx ); X X foreach (@$methods){ X $pre = $pst = $cmt = $idx = ''; X if( defined $refs->{$_} ){ X $pre = "\\("; X $pst = ")"; X $cmt = " # returns ref"; X } X $$out .= " sub $_ {$cmt\n my \$r = shift;\n"; X if( $type eq 'ARRAY' ){ X $elem = "[$cnt]"; X ++$cnt; X } X elsif( $type eq 'HASH' ){ X $elem = "{'$_'}"; X } X if( defined $arrays->{$_} ){ X $$out .= " my \$i;\n"; X $$out .= " \@_ ? (\$i = shift) : return \$r->$elem;\n"; X $idx = "->[\$i]"; X } X elsif( defined $hashes->{$_} ){ X $$out .= " my \$i;\n"; X $$out .= " \@_ ? (\$i = shift) : return \$r->$elem;\n"; X $idx = "->{\$i}"; X } X $$out .= " \@_ ? (\$r->$elem$idx = shift) : $pre\$r->$elem$idx$pst;\n"; X $$out .= " }\n"; X } } X 1; SHAR_EOF $shar_touch -am 1108060296 'obstructs/Class/Template.pm' && chmod 0644 'obstructs/Class/Template.pm' || $echo 'restore of' 'obstructs/Class/Template.pm' 'failed' if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \ && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then md5sum -c << SHAR_EOF >/dev/null 2>&1 \ || $echo 'obstructs/Class/Template.pm:' 'MD5 check failed' 4ccfb1ef6cb0ef795d19325556a78797 obstructs/Class/Template.pm SHAR_EOF else shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/Class/Template.pm'`" test 5024 -eq "$shar_count" || $echo 'obstructs/Class/Template.pm:' 'original size' '5024,' 'current size' "$shar_count!" fi fi # ============= obstructs/File/stat.pm ============== if test ! -d 'obstructs/File'; then $echo 'x -' 'creating directory' 'obstructs/File' mkdir 'obstructs/File' fi if test -f 'obstructs/File/stat.pm' && test "$first_param" != -c; then $echo 'x -' SKIPPING 'obstructs/File/stat.pm' '(file already exists)' else $echo 'x -' extracting 'obstructs/File/stat.pm' '(text)' sed 's/^X//' << 'SHAR_EOF' > 'obstructs/File/stat.pm' && package File::stat; use strict; X BEGIN { X use Exporter (); X use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); X @ISA = qw(Exporter); X @EXPORT = qw(stat lstat); X @EXPORT_OK = qw( $st_dev $st_ino $st_mode X $st_nlink $st_uid $st_gid X $st_rdev $st_size X $st_atime $st_mtime $st_ctime X $st_blksize $st_blocks X ); X %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); } use vars @EXPORT_OK; X use Class::Template qw(struct); struct 'File::stat' => [ X map { $_ => '$' } qw{ X dev ino mode nlink uid gid rdev size X atime mtime ctime blksize blocks X } ]; X sub populate (@) { X return unless @_; X my $stob = new(); X @$stob = ( X $st_dev, $st_ino, $st_mode, $st_nlink, $st_uid, $st_gid, $st_rdev, X $st_size, $st_atime, $st_mtime, $st_ctime, $st_blksize, $st_blocks ) X = @_; X return $stob; } X sub lstat (*) { populate(CORE::lstat(shift)) } X sub stat ($) { X my $arg = shift; X my $st = populate(CORE::stat $arg); X return $st if $st; X no strict 'refs'; X require Symbol; X return populate(CORE::stat \*{Symbol::qualify($arg)}); } X 1; __END__ X =head1 NAME X File::stat.pm - by-name interface to Perl's built-in stat() functions X =head1 SYNOPSIS X X use File::stat; X $st = stat($file) or die "No $file: $!"; X if ( ($st->mode & 0111) && $st->nlink > 1) ) { X print "$file is executable with lotsa links\n"; X } X X use File::stat qw(:FIELDS); X stat($file) or die "No $file: $!"; X if ( ($st_mode & 0111) && $st_nlink > 1) ) { X print "$file is executable with lotsa links\n"; X } X =head1 DESCRIPTION X This module's default exports override the core stat() and lstat() functions, replacing them with versions that return "File::stat" objects. This object has methods that return the similarly named structure field name from the stat(2) function; namely, dev, ino, mode, nlink, uid, gid, rdev, size, atime, mtime, ctime, blksize, and blocks. X You may also import all the structure fields directly into your namespace as regular variables using the :FIELDS import tag. (Note that this still overrides your stat() and lstat() functions.) Access these fields as variables named with a preceding C in front their method names. Thus, C<$stat_obj-Edev()> corresponds to $st_dev if you import the fields. X To access this functionality without the core overrides, pass the C an empty import list, and then access function functions with their full qualified names. On the other hand, the built-ins are still available via the C pseudo-package. X =head1 NOTE X While this class is currently implemented using the Class::Template module to build a struct-like class, you shouldn't rely upon this. X =head1 AUTHOR X Tom Christiansen SHAR_EOF $shar_touch -am 1129130296 'obstructs/File/stat.pm' && chmod 0644 'obstructs/File/stat.pm' || $echo 'restore of' 'obstructs/File/stat.pm' 'failed' if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \ && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then md5sum -c << SHAR_EOF >/dev/null 2>&1 \ || $echo 'obstructs/File/stat.pm:' 'MD5 check failed' 4d121fbb2e918b7f35c2b6fa2df6ffed obstructs/File/stat.pm SHAR_EOF else shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/File/stat.pm'`" test 2782 -eq "$shar_count" || $echo 'obstructs/File/stat.pm:' 'original size' '2782,' 'current size' "$shar_count!" fi fi # ============= obstructs/Net/hostent.pm ============== if test ! -d 'obstructs/Net'; then $echo 'x -' 'creating directory' 'obstructs/Net' mkdir 'obstructs/Net' fi if test -f 'obstructs/Net/hostent.pm' && test "$first_param" != -c; then $echo 'x -' SKIPPING 'obstructs/Net/hostent.pm' '(file already exists)' else $echo 'x -' extracting 'obstructs/Net/hostent.pm' '(text)' sed 's/^X//' << 'SHAR_EOF' > 'obstructs/Net/hostent.pm' && package Net::hostent; use strict; X BEGIN { X use Exporter (); X use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); X @ISA = qw(Exporter); X @EXPORT = qw(gethostbyname gethostbyaddr gethost); X @EXPORT_OK = qw( X $h_name @h_aliases X $h_addrtype $h_length X @h_addr_list $h_addr X ); X %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); } use vars @EXPORT_OK; X use Class::Template qw(struct); struct 'Net::hostent' => [ X name => '$', X aliases => '@', X addrtype => '$', X 'length' => '$', X addr_list => '@', ]; X sub addr { shift->addr_list->[0] } X sub populate (@) { X return unless @_; X my $hob = new(); X $h_name = $hob->[0] = $_[0]; X @h_aliases = @{ $hob->[1] } = split ' ', $_[1]; X $h_addrtype = $hob->[2] = $_[2]; X $h_length = $hob->[3] = $_[3]; X $h_addr = $_[4]; X @h_addr_list = @{ $hob->[4] } = @_[ (4 .. $#_) ]; X return $hob; } X sub gethostbyname ($) { populate(CORE::gethostbyname(shift)) } X sub gethostbyaddr ($;$) { X my ($addr, $addrtype); X $addr = shift; X require Socket unless @_; X $addrtype = @_ ? shift : Socket::AF_INET(); X populate(CORE::gethostbyaddr($addr, $addrtype)) } X sub gethost($) { X if ($_[0] =~ /^\d+(?:\.\d+(?:\.\d+(?:\.\d+)?)?)?$/) { X require Socket; X &gethostbyaddr(Socket::inet_aton(shift)); X } else { X &gethostbyname; X } } X 1; __END__ X =head1 NAME X Net::hostent - by-name interface to Perl's built-in gethost*() functions X =head1 SYNOPSIS X X use Net::hostnet; X =head1 DESCRIPTION X This module's default exports override the core gethostbyname() and gethostbyaddr() functions, replacing them with versions that return "Net::hostent" objects. This object has methods that return the similarly named structure field name from the C's hostent structure from F; namely name, aliases, addrtype, length, and addresses. The aliases and addresses methods return array reference, the rest scalars. The addr method is equivalent to the zeroth element in the addresses array reference. X You may also import all the structure fields directly into your namespace as regular variables using the :FIELDS import tag. (Note that this still overrides your core functions.) Access these fields as variables named with a preceding C. Thus, C<$host_obj-Ename()> corresponds to $h_name if you import the fields. Array references are available as regular array variables, so for example C<@{ $host_obj-Ealiases() }> would be simply @h_aliases. X The gethost() funtion is a simple front-end that forwards a numeric argument to gethostbyaddr() by way of Socket::inet_aton, and the rest to gethostbyname(). X To access this functionality without the core overrides, pass the C an empty import list, and then access function functions with their full qualified names. On the other hand, the built-ins are still available via the C pseudo-package. X =head1 EXAMPLES X X use Net::hostent; X use Socket; X X @ARGV = ('netscape.com') unless @ARGV; X X for $host ( @ARGV ) { X X unless ($h = gethost($host)) { X warn "$0: no such host: $host\n"; X next; X } X X printf "\n%s is %s%s\n", X $host, X lc($h->name) eq lc($host) ? "" : "*really* ", X $h->name; X X print "\taliases are ", join(", ", @{$h->aliases}), "\n" X if @{$h->aliases}; X X if ( @{$h->addr_list} > 1 ) { X my $i; X for $addr ( @{$h->addr_list} ) { X printf "\taddr #%d is [%s]\n", $i++, inet_ntoa($addr); X } X } else { X printf "\taddress is [%s]\n", inet_ntoa($h->addr); X } X X if ($h = gethostbyaddr($h->addr)) { X if (lc($h->name) ne lc($host)) { X printf "\tThat addr reverses to host %s!\n", $h->name; X $host = $h->name; X redo; X } X } X } X =head1 NOTE X While this class is currently implemented using the Class::Template module to build a struct-like class, you shouldn't rely upon this. X =head1 AUTHOR X Tom Christiansen SHAR_EOF $shar_touch -am 1129133896 'obstructs/Net/hostent.pm' && chmod 0644 'obstructs/Net/hostent.pm' || $echo 'restore of' 'obstructs/Net/hostent.pm' 'failed' if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \ && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then md5sum -c << SHAR_EOF >/dev/null 2>&1 \ || $echo 'obstructs/Net/hostent.pm:' 'MD5 check failed' 27e11c684fe0e621da0109fa7ecef0d9 obstructs/Net/hostent.pm SHAR_EOF else shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/Net/hostent.pm'`" test 3961 -eq "$shar_count" || $echo 'obstructs/Net/hostent.pm:' 'original size' '3961,' 'current size' "$shar_count!" fi fi # ============= obstructs/Net/netent.pm ============== if test -f 'obstructs/Net/netent.pm' && test "$first_param" != -c; then $echo 'x -' SKIPPING 'obstructs/Net/netent.pm' '(file already exists)' else $echo 'x -' extracting 'obstructs/Net/netent.pm' '(text)' sed 's/^X//' << 'SHAR_EOF' > 'obstructs/Net/netent.pm' && package Net::netent; use strict; X BEGIN { X use Exporter (); X use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); X @ISA = qw(Exporter); X @EXPORT = qw(getnetbyname getnetbyaddr getnet); X @EXPORT_OK = qw( X $n_name @n_aliases X $n_addrtype $n_net X ); X %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); } use vars @EXPORT_OK; X use Class::Template qw(struct); struct 'Net::netent' => [ X name => '$', X aliases => '@', X addrtype => '$', X net => '$', ]; X sub populate (@) { X return unless @_; X my $nob = new(); X $n_name = $nob->[0] = $_[0]; X @n_aliases = @{ $nob->[1] } = split ' ', $_[1]; X $n_addrtype = $nob->[2] = $_[2]; X $n_net = $nob->[3] = $_[3]; X return $nob; } X sub getnetbyname ($) { populate(CORE::getnetbyname(shift)) } X sub getnetbyaddr ($;$) { X my ($net, $addrtype); X $net = shift; X require Socket if @_; X $addrtype = @_ ? shift : Socket::AF_INET(); X populate(CORE::getnetbyaddr($net, $addrtype)) } X sub getnet($) { X if ($_[0] =~ /^\d+(?:\.\d+(?:\.\d+(?:\.\d+)?)?)?$/) { X require Socket; X &getnetbyaddr(Socket::inet_aton(shift)); X } else { X &getnetbyname; X } } X 1; __END__ X =head1 NAME X Net::netent - by-name interface to Perl's built-in getnet*() functions X =head1 SYNOPSIS X X use Net::netent qw(:FIELDS); X getnetbyname("loopback") or die "bad net"; X printf "%s is %08X\n", $n_name, $n_net; X X use Net::netent; X X $n = getnetbyname("loopback") or die "bad net"; X { # there's gotta be a better way, eh? X @bytes = unpack("C4", pack("N", $n->net)); X shift @bytes while @bytes && $bytes[0] == 0; X } X printf "%s is %08X [%d.%d.%d.%d]\n", $n->name, $n->net, @bytes; X =head1 DESCRIPTION X This module's default exports override the core getnetbyname() and getnetbyaddr() functions, replacing them with versions that return "Net::netent" objects. This object has methods that return the similarly named structure field name from the C's netent structure from F; namely name, aliases, addrtype, and net. The aliases method returns an array reference, the rest scalars. X You may also import all the structure fields directly into your namespace as regular variables using the :FIELDS import tag. (Note that this still overrides your core functions.) Access these fields as variables named with a preceding C. Thus, C<$net_obj-Ename()> corresponds to $n_name if you import the fields. Array references are available as regular array variables, so for example C<@{ $net_obj-Ealiases() }> would be simply @n_aliases. X The getnet() funtion is a simple front-end that forwards a numeric argument to getnetbyaddr(), and the rest to getnetbyname(). X To access this functionality without the core overrides, pass the C an empty import list, and then access function functions with their full qualified names. On the other hand, the built-ins are still available via the C pseudo-package. X =head1 EXAMPLES X The getnet() functions do this in the Perl core: X X sv_setiv(sv, (I32)nent->n_net); X The gethost() functions do this in the Perl core: X X sv_setpvn(sv, hent->h_addr, len); X That means that the address comes back in binary for the host functions, and as a regular perl integer for the net ones. This seems a bug, but here's how to deal with it: X X use strict; X use Socket; X use Net::netent; X X @ARGV = ('loopback') unless @ARGV; X X my($n, $net); X X for $net ( @ARGV ) { X X unless ($n = getnetbyname($net)) { X warn "$0: no such net: $net\n"; X next; X } X X printf "\n%s is %s%s\n", X $net, X lc($n->name) eq lc($net) ? "" : "*really* ", X $n->name; X X print "\taliases are ", join(", ", @{$n->aliases}), "\n" X if @{$n->aliases}; X X # this is stupid; first, why is this not in binary? X # second, why am i going through these convolutions X # to make it looks right X { X my @a = unpack("C4", pack("N", $n->net)); X shift @a while @a && $a[0] == 0; X printf "\taddr is %s [%d.%d.%d.%d]\n", $n->net, @a; X } X X if ($n = getnetbyaddr($n->net)) { X if (lc($n->name) ne lc($net)) { X printf "\tThat addr reverses to net %s!\n", $n->name; X $net = $n->name; X redo; X } X } X } X =head1 NOTE X While this class is currently implemented using the Class::Template module to build a struct-like class, you shouldn't rely upon this. X =head1 AUTHOR X Tom Christiansen SHAR_EOF $shar_touch -am 1130091396 'obstructs/Net/netent.pm' && chmod 0644 'obstructs/Net/netent.pm' || $echo 'restore of' 'obstructs/Net/netent.pm' 'failed' if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \ && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then md5sum -c << SHAR_EOF >/dev/null 2>&1 \ || $echo 'obstructs/Net/netent.pm:' 'MD5 check failed' e75ca81b142c8df118f1cdddc285f71a obstructs/Net/netent.pm SHAR_EOF else shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/Net/netent.pm'`" test 4435 -eq "$shar_count" || $echo 'obstructs/Net/netent.pm:' 'original size' '4435,' 'current size' "$shar_count!" fi fi # ============= obstructs/Net/protoent.pm ============== if test -f 'obstructs/Net/protoent.pm' && test "$first_param" != -c; then $echo 'x -' SKIPPING 'obstructs/Net/protoent.pm' '(file already exists)' else $echo 'x -' extracting 'obstructs/Net/protoent.pm' '(text)' sed 's/^X//' << 'SHAR_EOF' > 'obstructs/Net/protoent.pm' && package Net::protoent; use strict; X BEGIN { X use Exporter (); X use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); X @ISA = qw(Exporter); X @EXPORT = qw(getprotobyname getprotobynumber getprotoent); X @EXPORT_OK = qw( $p_name @p_aliases $p_proto ); X %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); } use vars @EXPORT_OK; X use Class::Template qw(struct); struct 'Net::protoent' => [ X name => '$', X aliases => '@', X proto => '$', ]; X sub populate (@) { X return unless @_; X my $pob = new(); X $p_name = $pob->[0] = $_[0]; X @p_aliases = @{ $pob->[1] } = split ' ', $_[1]; X $p_proto = $pob->[2] = $_[2]; X return $pob; } X sub getprotoent ( ) { populate(CORE::getprotoent()) } sub getprotobyname ($) { populate(CORE::getprotobyname(shift)) } sub getprotobynumber ($) { populate(CORE::getprotobynumber(shift)) } X sub getproto ($;$) { X no strict 'refs'; X return &{'getprotoby' . ($_[0]=~/^\d+$/ ? 'number' : 'name')}(@_); } X 1; X __END__ X =head1 NAME X Net::protoent - by-name interface to Perl's built-in getproto*() functions X =head1 SYNOPSIS X X use Net::protoent; X $p = getprotobyname(shift || 'tcp') || die "no proto"; X printf "proto for %s is %d, aliases are %s\n", X $p->name, $p->proto, "@{$p->aliases}"; X X use Net::protoent qw(:FIELDS); X getprotobyname(shift || 'tcp') || die "no proto"; X print "proto for $p_name is $p_proto, aliases are @p_aliases\n"; X =head1 DESCRIPTION X This module's default exports override the core getprotoent(), getprotobyname(), and getnetbyport() functions, replacing them with versions that return "Net::protoent" objects. They take default second arguments of "tcp". This object has methods that return the similarly named structure field name from the C's protoent structure from F; namely name, aliases, and proto. The aliases method returns an array reference, the rest scalars. X You may also import all the structure fields directly into your namespace as regular variables using the :FIELDS import tag. (Note that this still overrides your core functions.) Access these fields as variables named with a preceding C. Thus, C<$proto_obj-Ename()> corresponds to $p_name if you import the fields. Array references are available as regular array variables, so for example C<@{ $proto_obj-Ealiases() }> would be simply @p_aliases. X The getproto() function is a simple front-end that forwards a numeric argument to getprotobyport(), and the rest to getprotobyname(). X To access this functionality without the core overrides, pass the C an empty import list, and then access function functions with their full qualified names. On the other hand, the built-ins are still available via the C pseudo-package. X =head1 NOTE X While this class is currently implemented using the Class::Template module to build a struct-like class, you shouldn't rely upon this. X =head1 AUTHOR X Tom Christiansen SHAR_EOF $shar_touch -am 1130095196 'obstructs/Net/protoent.pm' && chmod 0644 'obstructs/Net/protoent.pm' || $echo 'restore of' 'obstructs/Net/protoent.pm' 'failed' if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \ && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then md5sum -c << SHAR_EOF >/dev/null 2>&1 \ || $echo 'obstructs/Net/protoent.pm:' 'MD5 check failed' c8e24414a4b93b93dab2b257e15bdd38 obstructs/Net/protoent.pm SHAR_EOF else shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/Net/protoent.pm'`" test 2973 -eq "$shar_count" || $echo 'obstructs/Net/protoent.pm:' 'original size' '2973,' 'current size' "$shar_count!" fi fi # ============= obstructs/Net/servent.pm ============== if test -f 'obstructs/Net/servent.pm' && test "$first_param" != -c; then $echo 'x -' SKIPPING 'obstructs/Net/servent.pm' '(file already exists)' else $echo 'x -' extracting 'obstructs/Net/servent.pm' '(text)' sed 's/^X//' << 'SHAR_EOF' > 'obstructs/Net/servent.pm' && package Net::servent; use strict; X BEGIN { X use Exporter (); X use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); X @ISA = qw(Exporter); X @EXPORT = qw(getservbyname getservbyport getservent getserv); X @EXPORT_OK = qw( $s_name @s_aliases $s_port $s_proto ); X %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); } use vars @EXPORT_OK; X use Class::Template qw(struct); struct 'Net::servent' => [ X name => '$', X aliases => '@', X port => '$', X proto => '$', ]; X sub populate (@) { X return unless @_; X my $sob = new(); X $s_name = $sob->[0] = $_[0]; X @s_aliases = @{ $sob->[1] } = split ' ', $_[1]; X $s_port = $sob->[2] = $_[2]; X $s_proto = $sob->[3] = $_[3]; X return $sob; } X sub getservent ( ) { populate(CORE::getservent()) } sub getservbyname ($;$) { populate(CORE::getservbyname(shift,shift||'tcp')) } sub getservbyport ($;$) { populate(CORE::getservbyport(shift,shift||'tcp')) } X sub getserv ($;$) { X no strict 'refs'; X return &{'getservby' . ($_[0]=~/^\d+$/ ? 'port' : 'name')}(@_); } X 1; X __END__ X =head1 NAME X Net::servent - by-name interface to Perl's built-in getserv*() functions X =head1 SYNOPSIS X X use Net::servent; X $s = getservbyname(shift || 'ftp') || die "no service"; X printf "port for %s is %s, aliases are %s\n", X $s->name, $s->port, "@{$s->aliases}"; X X use Net::servent qw(:FIELDS); X getservbyname(shift || 'ftp') || die "no service"; X print "port for $s_name is $s_port, aliases are @s_aliases\n"; X =head1 DESCRIPTION X This module's default exports override the core getservent(), getservbyname(), and getnetbyport() functions, replacing them with versions that return "Net::servent" objects. They take default second arguments of "tcp". This object has methods that return the similarly named structure field name from the C's servent structure from F; namely name, aliases, port, and proto. The aliases method returns an array reference, the rest scalars. X You may also import all the structure fields directly into your namespace as regular variables using the :FIELDS import tag. (Note that this still overrides your core functions.) Access these fields as variables named with a preceding C. Thus, C<$serv_obj-Ename()> corresponds to $s_name if you import the fields. Array references are available as regular array variables, so for example C<@{ $serv_obj-Ealiases() }> would be simply @s_aliases. X The getserv() function is a simple front-end that forwards a numeric argument to getservbyport(), and the rest to getservbyname(). X To access this functionality without the core overrides, pass the C an empty import list, and then access function functions with their full qualified names. On the other hand, the built-ins are still available via the C pseudo-package. X =head1 EXAMPLES X X use Net::servent qw(:FIELDS); X X while (@ARGV) { X my ($service, $proto) = ((split m!/!, shift), 'tcp'); X my $valet = getserv($service, $proto); X unless ($valet) { X warn "$0: No service: $service/$proto\n" X next; X } X printf "service $service/$proto is port %d\n", $valet->port; X print "alias are @s_aliases\n" if @s_aliases; X } X =head1 NOTE X While this class is currently implemented using the Class::Template module to build a struct-like class, you shouldn't rely upon this. X =head1 AUTHOR X Tom Christiansen SHAR_EOF $shar_touch -am 1130094396 'obstructs/Net/servent.pm' && chmod 0644 'obstructs/Net/servent.pm' || $echo 'restore of' 'obstructs/Net/servent.pm' 'failed' if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \ && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then md5sum -c << SHAR_EOF >/dev/null 2>&1 \ || $echo 'obstructs/Net/servent.pm:' 'MD5 check failed' b09a8a3151b490a083236f84aae0e689 obstructs/Net/servent.pm SHAR_EOF else shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/Net/servent.pm'`" test 3424 -eq "$shar_count" || $echo 'obstructs/Net/servent.pm:' 'original size' '3424,' 'current size' "$shar_count!" fi fi # ============= obstructs/Time/gmtime.pm ============== if test ! -d 'obstructs/Time'; then $echo 'x -' 'creating directory' 'obstructs/Time' mkdir 'obstructs/Time' fi if test -f 'obstructs/Time/gmtime.pm' && test "$first_param" != -c; then $echo 'x -' SKIPPING 'obstructs/Time/gmtime.pm' '(file already exists)' else $echo 'x -' extracting 'obstructs/Time/gmtime.pm' '(text)' sed 's/^X//' << 'SHAR_EOF' > 'obstructs/Time/gmtime.pm' && package Time::gmtime; use strict; use Time::tm; X BEGIN { X use Exporter (); X use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); X @ISA = qw(Exporter Time::tm); X @EXPORT = qw(gmtime gmctime); X @EXPORT_OK = qw( X $tm_sec $tm_min $tm_hour $tm_mday X $tm_mon $tm_year $tm_wday $tm_yday X $tm_isdst X ); X %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); } use vars @EXPORT_OK; X sub populate (@) { X return unless @_; X my $tmob = Time::tm->new(); X @$tmob = ( X $tm_sec, $tm_min, $tm_hour, $tm_mday, X $tm_mon, $tm_year, $tm_wday, $tm_yday, X $tm_isdst ) X = @_; X return $tmob; } X sub gmtime (;$) { populate CORE::gmtime(shift||time)} sub gmctime (;$) { scalar CORE::gmtime(shift||time)} X 1; __END__ X =head1 NAME X Time::gmtime.pm - by-name interface to Perl's built-in gmtime() function X =head1 SYNOPSIS X X use Time::gmtime; X $gm = gmtime(); X printf "The day in Greenwich is %s\n", X (qw(Sun Mon Tue Wed Thu Fri Sat Sun))[ gm->wday() ]; X X use Time::gmtime w(:FIELDS; X printf "The day in Greenwich is %s\n", X (qw(Sun Mon Tue Wed Thu Fri Sat Sun))[ gm_wday() ]; X X $now = gmctime(); X X use Time::gmtime; X use File::stat; X $date_string = gmctime(stat($file)->mtime); X =head1 DESCRIPTION X This module's default exports override the core gmtime() function, replacing it with a version that returns "Time::tm" objects. This object has methods that return the similarly named structure field name from the C's tm structure from F; namely sec, min, hour, mday, mon, year, wday, yday, and isdst. X You may also import all the structure fields directly into your namespace as regular variables using the :FIELDS import tag. (Note that this still overrides your core functions.) Access these fields as variables named with a preceding C in front their method names. Thus, C<$tm_obj-Emday()> corresponds to $tm_mday if you import the fields. X The gmctime() funtion provides a way of getting at the scalar sense of the original CORE::gmtime() function. X To access this functionality without the core overrides, pass the C an empty import list, and then access function functions with their full qualified names. On the other hand, the built-ins are still available via the C pseudo-package. X =head1 NOTE X While this class is currently implemented using the Class::Template module to build a struct-like class, you shouldn't rely upon this. X =head1 AUTHOR X Tom Christiansen SHAR_EOF $shar_touch -am 1129132196 'obstructs/Time/gmtime.pm' && chmod 0644 'obstructs/Time/gmtime.pm' || $echo 'restore of' 'obstructs/Time/gmtime.pm' 'failed' if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \ && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then md5sum -c << SHAR_EOF >/dev/null 2>&1 \ || $echo 'obstructs/Time/gmtime.pm:' 'MD5 check failed' 8617e4442d682c2bc444e12b612f98e2 obstructs/Time/gmtime.pm SHAR_EOF else shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/Time/gmtime.pm'`" test 2476 -eq "$shar_count" || $echo 'obstructs/Time/gmtime.pm:' 'original size' '2476,' 'current size' "$shar_count!" fi fi # ============= obstructs/Time/localtime.pm ============== if test -f 'obstructs/Time/localtime.pm' && test "$first_param" != -c; then $echo 'x -' SKIPPING 'obstructs/Time/localtime.pm' '(file already exists)' else $echo 'x -' extracting 'obstructs/Time/localtime.pm' '(text)' sed 's/^X//' << 'SHAR_EOF' > 'obstructs/Time/localtime.pm' && package Time::localtime; use strict; use Time::tm; X BEGIN { X use Exporter (); X use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); X @ISA = qw(Exporter Time::tm); X @EXPORT = qw(localtime ctime); X @EXPORT_OK = qw( X $tm_sec $tm_min $tm_hour $tm_mday X $tm_mon $tm_year $tm_wday $tm_yday X $tm_isdst X ); X %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); } use vars @EXPORT_OK; X sub populate (@) { X return unless @_; X my $tmob = Time::tm->new(); X @$tmob = ( X $tm_sec, $tm_min, $tm_hour, $tm_mday, X $tm_mon, $tm_year, $tm_wday, $tm_yday, X $tm_isdst ) X = @_; X return $tmob; } X sub localtime (;$) { populate CORE::localtime(shift||time)} sub ctime (;$) { scalar CORE::localtime(shift||time) } X 1; X __END__ X =head1 NAME X Time::localtime.pm - by-name interface to Perl's built-in localtime() function X =head1 SYNOPSIS X X use Time::localtime; X printf "Year is %d\n", localtime->year() + 1900; X X $now = ctime(); X X use Time::localtime; X use File::stat; X $date_string = ctime(stat($file)->mtime); X =head1 DESCRIPTION X This module's default exports override the core localtime() function, replacing it with a version that returns "Time::tm" objects. This object has methods that return the similarly named structure field name from the C's tm structure from F; namely sec, min, hour, mday, mon, year, wday, yday, and isdst. X You may also import all the structure fields directly into your namespace as regular variables using the :FIELDS import tag. (Note that this still overrides your core functions.) Access these fields as variables named with a preceding C in front their method names. Thus, C<$tm_obj-Emday()> corresponds to $tm_mday if you import the fields. X The ctime() funtion provides a way of getting at the scalar sense of the original CORE::localtime() function. X To access this functionality without the core overrides, pass the C an empty import list, and then access function functions with their full qualified names. On the other hand, the built-ins are still available via the C pseudo-package. X =head1 NOTE X While this class is currently implemented using the Class::Template module to build a struct-like class, you shouldn't rely upon this. X =head1 AUTHOR X Tom Christiansen SHAR_EOF $shar_touch -am 1129132196 'obstructs/Time/localtime.pm' && chmod 0644 'obstructs/Time/localtime.pm' || $echo 'restore of' 'obstructs/Time/localtime.pm' 'failed' if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \ && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then md5sum -c << SHAR_EOF >/dev/null 2>&1 \ || $echo 'obstructs/Time/localtime.pm:' 'MD5 check failed' 4f44256053f0573143e7f1b78e3db9b1 obstructs/Time/localtime.pm SHAR_EOF else shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/Time/localtime.pm'`" test 2307 -eq "$shar_count" || $echo 'obstructs/Time/localtime.pm:' 'original size' '2307,' 'current size' "$shar_count!" fi fi # ============= obstructs/Time/tm.pm ============== if test -f 'obstructs/Time/tm.pm' && test "$first_param" != -c; then $echo 'x -' SKIPPING 'obstructs/Time/tm.pm' '(file already exists)' else $echo 'x -' extracting 'obstructs/Time/tm.pm' '(text)' sed 's/^X//' << 'SHAR_EOF' > 'obstructs/Time/tm.pm' && package Time::tm; use strict; X use Class::Template qw(struct); struct('Time::tm' => [ X map { $_ => '$' } qw{ sec min hour mday mon year wday yday isdst } ]); X 1; __END__ X =head1 NAME X Time::tm.pm - internal object used by Time::gmtime and Time::localtime X =head1 DESCRIPTION X This module is used internally as a base class by Time::localtime And Time::gmtime functions. It creates a Time::tm struct object which is addressable just like's C's tm structure from F; namely with sec, min, hour, mday, mon, year, wday, yday, and isdst. X This class is an internal interface only. X =head1 AUTHOR X Tom Christiansen SHAR_EOF $shar_touch -am 1129132696 'obstructs/Time/tm.pm' && chmod 0644 'obstructs/Time/tm.pm' || $echo 'restore of' 'obstructs/Time/tm.pm' 'failed' if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \ && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then md5sum -c << SHAR_EOF >/dev/null 2>&1 \ || $echo 'obstructs/Time/tm.pm:' 'MD5 check failed' 02859f003106bb6eb92cc91bb9b37666 obstructs/Time/tm.pm SHAR_EOF else shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/Time/tm.pm'`" test 622 -eq "$shar_count" || $echo 'obstructs/Time/tm.pm:' 'original size' '622,' 'current size' "$shar_count!" fi fi # ============= obstructs/User/grent.pm ============== if test ! -d 'obstructs/User'; then $echo 'x -' 'creating directory' 'obstructs/User' mkdir 'obstructs/User' fi if test -f 'obstructs/User/grent.pm' && test "$first_param" != -c; then $echo 'x -' SKIPPING 'obstructs/User/grent.pm' '(file already exists)' else $echo 'x -' extracting 'obstructs/User/grent.pm' '(text)' sed 's/^X//' << 'SHAR_EOF' > 'obstructs/User/grent.pm' && package User::grent; use strict; X BEGIN { X use Exporter (); X use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); X @ISA = qw(Exporter); X @EXPORT = qw(getgrent getgrgid getgrnam getgr); X @EXPORT_OK = qw($gr_name $gr_gid $gr_passwd $gr_mem @gr_members); X %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); } use vars @EXPORT_OK; X use Class::Template qw(struct); struct 'User::grent' => [ X name => '$', X passwd => '$', X gid => '$', X members => '@', ]; X sub populate (@) { X return unless @_; X my $gob = new(); X ($gr_name, $gr_passwd, $gr_gid) = @$gob[0,1,2] = @_[0,1,2]; X @gr_members = @{$gob->[3]} = split ' ', $_[3]; X return $gob; } X sub getgrent ( ) { populate(CORE::getgrent()) } sub getgrnam ($) { populate(CORE::getgrnam(shift)) } sub getgrgid ($) { populate(CORE::getgrgid(shift)) } sub getgr ($) { ($_[0] =~ /^\d+/) ? &getgrgid : &getgrnam } X 1; __END__ X =head1 NAME X User::grent.pm - by-name interface to Perl's built-in getgr*() functions X =head1 SYNOPSIS X X use User::grent; X $gr = getgrgid(0) or die "No group zero"; X if ( $gr->name eq 'wheel' && @{$gr->members} > 1 ) { X print "gid zero name wheel, with other members"; X } X X use User::grent qw(:FIELDS; X getgrgid(0) or die "No group zero"; X if ( $gr_name eq 'wheel' && @gr_members > 1 ) { X print "gid zero name wheel, with other members"; X } X X $gr = getgr($whoever); X =head1 DESCRIPTION X This module's default exports override the core getgrent(), getgruid(), and getgrnam() functions, replacing them with versions that return "User::grent" objects. This object has methods that return the similarly named structure field name from the C's passwd structure from F; namely name, passwd, gid, and members (not mem). The first three return scalars, the last an array reference. X You may also import all the structure fields directly into your namespace as regular variables using the :FIELDS import tag. (Note that this still overrides your core functions.) Access these fields as variables named with a preceding C. Thus, C<$group_obj-Egid()> corresponds to $gr_gid if you import the fields. Array references are available as regular array variables, so C<@{ $group_obj-Emembers() }> would be simply @gr_members. X The getpw() funtion is a simple front-end that forwards a numeric argument to getpwuid() and the rest to getpwnam(). X To access this functionality without the core overrides, pass the C an empty import list, and then access function functions with their full qualified names. On the other hand, the built-ins are still available via the C pseudo-package. X =head1 NOTE X While this class is currently implemented using the Class::Template module to build a struct-like class, you shouldn't rely upon this. X =head1 AUTHOR X Tom Christiansen SHAR_EOF $shar_touch -am 1130094696 'obstructs/User/grent.pm' && chmod 0644 'obstructs/User/grent.pm' || $echo 'restore of' 'obstructs/User/grent.pm' 'failed' if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \ && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then md5sum -c << SHAR_EOF >/dev/null 2>&1 \ || $echo 'obstructs/User/grent.pm:' 'MD5 check failed' 9fbf4010f722f9bc493657ec56f8ce5d obstructs/User/grent.pm SHAR_EOF else shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/User/grent.pm'`" test 2848 -eq "$shar_count" || $echo 'obstructs/User/grent.pm:' 'original size' '2848,' 'current size' "$shar_count!" fi fi # ============= obstructs/User/pwent.pm ============== if test -f 'obstructs/User/pwent.pm' && test "$first_param" != -c; then $echo 'x -' SKIPPING 'obstructs/User/pwent.pm' '(file already exists)' else $echo 'x -' extracting 'obstructs/User/pwent.pm' '(text)' sed 's/^X//' << 'SHAR_EOF' > 'obstructs/User/pwent.pm' && package User::pwent; use strict; X BEGIN { X use Exporter (); X use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); X @ISA = qw(Exporter); X @EXPORT = qw(getpwent getpwuid getpwnam getpw); X @EXPORT_OK = qw( X $pw_name $pw_passwd $pw_uid X $pw_gid $pw_quota $pw_comment X $pw_gecos $pw_dir $pw_shell X ); X %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); } use vars @EXPORT_OK; X use Class::Template qw(struct); struct 'User::pwent' => [ X name => '$', X passwd => '$', X uid => '$', X gid => '$', X quota => '$', X comment => '$', X gcos => '$', X dir => '$', X shell => '$', ]; X sub populate (@) { X return unless @_; X my $pwob = new(); X X ( $pw_name, $pw_passwd, $pw_uid, X $pw_gid, $pw_quota, $pw_comment, X $pw_gecos, $pw_dir, $pw_shell, ) = @$pwob = @_; X X return $pwob; } X sub getpwent ( ) { populate(CORE::getpwent()) } sub getpwnam ($) { populate(CORE::getpwnam(shift)) } sub getpwgid ($) { populate(CORE::getpwgid(shift)) } sub getpw ($) { ($_[0] =~ /^\d+/) ? &getpwgid : &getpwnam } X 1; __END__ X =head1 NAME X User::pwent.pm - by-name interface to Perl's built-in getpw*() functions X =head1 SYNOPSIS X X use User::pwent; X $pw = getpwnam('daemon') or die "No daemon user"; X if ( $pw->uid == 1 && $pw->dir =~ m#^/(bin|tmp)?$# ) { X print "gid 1 on root dir"; X } X X use User::pwent qw(:FIELDS); X getpwnam('daemon') or die "No daemon user"; X if ( $pw_uid == 1 && $pw_dir =~ m#^/(bin|tmp)?$# ) { X print "gid 1 on root dir"; X } X X $pw = getpw($whoever); X =head1 DESCRIPTION X This module's default exports override the core getpwent(), getpwuid(), and getpwnam() functions, replacing them with versions that return "User::pwent" objects. This object has methods that return the similarly named structure field name from the C's passwd structure from F; namely name, passwd, uid, gid, quota, comment, gecos, dir, and shell. X You may also import all the structure fields directly into your namespace as regular variables using the :FIELDS import tag. (Note that this still overrides your core functions.) Access these fields as variables named with a preceding C in front their method names. Thus, C<$passwd_obj-Eshell()> corresponds to $pw_shell if you import the fields. X The getpw() funtion is a simple front-end that forwards a numeric argument to getpwuid() and the rest to getpwnam(). X To access this functionality without the core overrides, pass the C an empty import list, and then access function functions with their full qualified names. On the other hand, the built-ins are still available via the C pseudo-package. X =head1 NOTE X While this class is currently implemented using the Class::Template module to build a struct-like class, you shouldn't rely upon this. X =head1 AUTHOR X Tom Christiansen SHAR_EOF $shar_touch -am 1130094696 'obstructs/User/pwent.pm' && chmod 0644 'obstructs/User/pwent.pm' || $echo 'restore of' 'obstructs/User/pwent.pm' 'failed' if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \ && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then md5sum -c << SHAR_EOF >/dev/null 2>&1 \ || $echo 'obstructs/User/pwent.pm:' 'MD5 check failed' 905033d579b32729f95a760e013dbde4 obstructs/User/pwent.pm SHAR_EOF else shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'obstructs/User/pwent.pm'`" test 2899 -eq "$shar_count" || $echo 'obstructs/User/pwent.pm:' 'original size' '2899,' 'current size' "$shar_count!" fi fi rm -fr _sh24166 exit 0 p5p-msgid: <199611301652.JAA24201@toy.perl.com> Subject: FileHandle that 'ISA' IO::File Date: Mon, 2 Dec 1996 17:18:02 GMT From: Nick Ing-Simmons Files: MANIFEST lib/FileHandle.pm Subject: FileHandle that 'is' and IO::File Andreas Koenig writes: >>>>>> Nick Ing-Simmons writes: > > > The patch will serve till we can get derived version working. > >I'm putting much hope in the your patch, Nick, because I have another >problem pending. No test case yet, because I'm waiting for your >FileHandle.pm. > >I'll let you know more details as soon as I have a structured view of >the problem. Your patch will (hopefully) help me to get there, > >andreas Please try attached. Drop into lib/FileHandle.pm p5p-msgid: <199612021718.RAA04416@pluto> Subject: 10+ debugger patch Date: Sun, 1 Dec 1996 06:37:31 -0500 (EST) From: Ilya Zakharevich Files: lib/perl5db.pl perl.c pod/perldebug.pod Bugs corrected: perl.c a) Could have deadlocked debugging its own signal handler; lib/perl5db.pl pod/perldebug.pod b) Documentation (internal and POD) updated; c) NonStop now will not stop at end; d) variable names more meaningful now; e) Will not trace last line of itself now; f) Dumping of looong lines in a program (see Config.pm) interruptable; g) $@ not wiped by evalled expressions; While updating the docs I was forced to change some API (to make it documentable), which resulted in following improvements: frame & 4 recognized: more verbose output; frame changes style of TRACE; Non-interruptable lines have no `:' in the listing; frame outputs `require'd packages as well. added Options AutoTrace inhibit_exit Though this may look a lot, all the changes are not in the main flow of execution (in frills which are usually disabled), so I think they may be added even this late in the cycle. Documentation would be quite messy without these changes. As well as I know, the documentation is complete now, so one can _really_ write a new debugger from scratch. Enjoy, p5p-msgid: <199612011137.GAA10864@monk.mps.ohio-state.edu> Subject: DB_File 1.07 From: Paul Marquess Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs t/lib/db-btree.t t/lib/db-recno.t Subject: DB_File 1.08 From: Paul Marquess Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs OTHER CORE CHANGES Subject: Eliminate spurious warning when splicing undefs From: Chip Salzenberg Files: pp.c sv.h Subject: Eliminate spurious warning from "x=" operator From: Chip Salzenberg Files: op.c Subject: Fix line numbers near control structures From: Chip Salzenberg Files: op.c perly.c perly.c.diff perly.y proto.h Subject: Don't let scalar unpack() underflow stack From: Chip Salzenberg Files: pp.c Subject: Fix core dump from precedence bug in "@foo" warning From: Chip Salzenberg Files: toke.c Subject: Move die() to utils.c; add varargs hack to croak() From: Chip Salzenberg Files: pp_ctl.c util.c Subject: Avoid memcmp() for magnitude test if it thinks char is signed From: Chip Salzenberg Files: Configure config_H config_h.SH doop.c ext/SDBM_File/sdbm/pair.c ext/SDBM_File/sdbm/sdbm.h handy.h hv.c perl.h pp_hot.c proto.h regexec.c sv.c toke.c util.c Subject: Fully paramaterize locales; disable all if NO_LOCALE From: Chip Salzenberg Files: ext/POSIX/POSIX.xs op.c perl.h pp.c pp_sys.c sv.c util.c PORTABILITY AND TESTING Subject: Bitwise op fix for Alpha From: Chip Salzenberg Files: pp.c Subject: VMS patches for 5.003_10 Date: Wed, 04 Dec 1996 16:40:12 -0500 (EST) From: Charles Bailey Files: EXTERN.h INTERN.h old_perl_exp.SH perl.c perl.h perl_exp.SH pp.c pp_ctl.c pp_sys.c proto.h sv.c toke.c util.c utils/perldoc.PL vms/config.vms vms/descrip.mms vms/gen_shrfls.pl vms/genconfig.pl vms/vmsish.h private-msgid: <01ICMALO8NMS001A1D@hmivax.humgen.upenn.edu> --- Changes | 171 +++- Configure | 77 +- EXTERN.h | 6 + INSTALL | 5 + INTERN.h | 6 + MANIFEST | 17 +- Makefile.SH | 2 +- config_H | 8 + config_h.SH | 8 + doio.c | 50 -- doop.c | 10 +- embed.pl | 1 + ext/DB_File/DB_File.pm | 103 ++- ext/DB_File/DB_File.xs | 24 +- ext/POSIX/POSIX.xs | 14 +- ext/SDBM_File/sdbm/pair.c | 2 +- ext/SDBM_File/sdbm/sdbm.h | 32 +- handy.h | 8 + hv.c | 20 +- hv.h | 2 +- installperl | 1 + keywords.pl | 1 + lib/Class/Template.pm | 241 ++++++ lib/ExtUtils/Embed.pm | 10 +- lib/File/Path.pm | 2 +- lib/File/stat.pm | 111 +++ lib/FileHandle.pm | 227 +++++ lib/Net/hostent.pm | 147 ++++ lib/Net/netent.pm | 165 ++++ lib/Net/protoent.pm | 92 ++ lib/Net/servent.pm | 109 +++ lib/Pod/Text.pm | 2 +- lib/Sys/Syslog.pm | 2 +- lib/Time/gmtime.pm | 87 ++ lib/Time/localtime.pm | 83 ++ lib/Time/tm.pm | 27 + lib/User/grent.pm | 91 ++ lib/User/pwent.pm | 101 +++ lib/perl5db.pl | 117 ++- lib/sigtrap.pm | 16 +- lib/syslog.pl | 2 +- old_embed.pl | 1 + old_perl_exp.SH | 4 +- op.c | 32 +- opcode.h | 4 +- opcode.pl | 5 +- patchlevel.h | 2 +- perl.c | 10 +- perl.h | 102 ++- perl_exp.SH | 4 +- perly.c | 2117 ++++++++++++++++++++++----------------------- perly.c.diff | 196 +++-- perly.h | 40 +- perly.y | 30 +- pod/perldebug.pod | 379 ++++++-- pod/perlfunc.pod | 2 + pod/perlobj.pod | 3 +- pod/perlref.pod | 26 +- pp.c | 149 ++-- pp_ctl.c | 59 +- pp_hot.c | 23 +- pp_sys.c | 44 +- proto.h | 8 +- regexec.c | 4 +- sv.c | 206 +++-- sv.h | 2 + t/base/term.t | 11 +- t/lib/db-btree.t | 6 +- t/lib/db-recno.t | 68 +- t/lib/filehand.t | 50 +- t/lib/safe2.t | 3 +- t/op/misc.t | 6 + toke.c | 10 +- util.c | 368 +++----- utils/perldoc.PL | 3 + vms/config.vms | 87 +- vms/descrip.mms | 2 +- vms/gen_shrfls.pl | 4 +- vms/genconfig.pl | 19 +- vms/vmsish.h | 4 +- 80 files changed, 4261 insertions(+), 2032 deletions(-) create mode 100644 lib/Class/Template.pm create mode 100644 lib/File/stat.pm create mode 100644 lib/FileHandle.pm create mode 100644 lib/Net/hostent.pm create mode 100644 lib/Net/netent.pm create mode 100644 lib/Net/protoent.pm create mode 100644 lib/Net/servent.pm create mode 100644 lib/Time/gmtime.pm create mode 100644 lib/Time/localtime.pm create mode 100644 lib/Time/tm.pm create mode 100644 lib/User/grent.pm create mode 100644 lib/User/pwent.pm diff --git a/Changes b/Changes index 9326ecf..51d876d 100644 --- a/Changes +++ b/Changes @@ -8,6 +8,173 @@ or in the .../src/5/0/unsupported directory for sub-version releases.) ---------------- +Version 5.003_11 +---------------- + +This patch is (still) closing in on 5.004. Nothing dramatic, lots of +value. + + CORE LANGUAGE CHANGES + + Title: "Fix precedence problems with subs as uniops or listops" + From: Chip Salzenberg + Files: perly.c perly.c.diff perly.h perly.y + + Title: "Don't reset $. on open()" + From: Chip Salzenberg + Files: pp_sys.c + + Title: "Support *glob{IO} (eventually deprecate *glob{FILEHANDLE})" + From: Chip Salzenberg + Files: pod/perlref.pod pp_hot.c sv.c + + Title: "Don't let expression context force return context" + From: Chip Salzenberg + Files: op.c + + Title: "Properly convert "1E2" et al to IV/UV" + From: Chip Salzenberg + Files: doio.c sv.c + + Title: "Fix modulo operator in UV realm" + From: Chip Salzenberg + Files: pp.c + + Title: "Fix stat(_) after stat(HANDLE)" + From: Chip Salzenberg + Files: pp_sys.c + + Title: "Fix: s/// and "$x =~ $y" under 'use locale'" + From: Chip Salzenberg + Files: op.c toke.c + + OTHER CORE CHANGES + + Title: "Eliminate spurious warning when splicing undefs" + From: Chip Salzenberg + Files: pp.c sv.h + + Title: "Eliminate spurious warning from "x=" operator" + From: Chip Salzenberg + Files: op.c + + Title: "Fix line numbers near control structures" + From: Chip Salzenberg + Files: op.c perly.c perly.c.diff perly.y proto.h + + Title: "Don't let scalar unpack() underflow stack" + From: Chip Salzenberg + Files: pp.c + + Title: "Fix core dump from precedence bug in "@foo" warning" + From: Chip Salzenberg + Files: toke.c + + Title: "Move die() to utils.c; add varargs hack to croak()" + From: Chip Salzenberg + Files: pp_ctl.c util.c + + Title: "Avoid memcmp() for magnitude test if it thinks char is signed" + From: Chip Salzenberg + Files: Configure config_H config_h.SH doop.c + ext/SDBM_File/sdbm/pair.c ext/SDBM_File/sdbm/sdbm.h handy.h + hv.c perl.h pp_hot.c proto.h regexec.c sv.c toke.c util.c + + Title: "Less malloc in magic" + From: Chip Salzenberg + Files: mg.c + + Title: "Re: 5.003_09: PADTMP fix" + From: Ilya Zakharevich + Msg-ID: <199611281150.GAA06884@monk.mps.ohio-state.edu> + Date: Thu, 28 Nov 1996 06:50:58 -0500 (EST) + Files: pod/perlguts.pod + + Title: "Fully paramaterize locales; disable all if NO_LOCALE" + From: Chip Salzenberg + Files: ext/POSIX/POSIX.xs op.c perl.h pp.c pp_sys.c sv.c util.c + + PORTABILITY AND TESTING + + Title: "Bitwise op fix for Alpha" + From: Chip Salzenberg + Files: pp.c + + Title: "hints/dgux.sh update" + From: Roderick Schertler + Msg-ID: <24178.849309616@eeyore.ibcinc.com> + Date: Fri, 29 Nov 1996 18:20:16 -0500 + Files: hints/dgux.sh + + Title: "BUG in hints/hpux.sh" + From: Jeff McDougal + Msg-ID: <32A42C11.7FA2@cris.com> + Date: Tue, 03 Dec 1996 08:33:05 -0500 + Files: hints/hpux.sh + + Title: "VMS patches for 5.003_10" + From: Charles Bailey + Msg-ID: <01ICMALO8NMS001A1D@hmivax.humgen.upenn.edu> + Date: Wed, 04 Dec 1996 16:40:12 -0500 (EST) + Files: EXTERN.h INTERN.h old_perl_exp.SH perl.c perl.h perl_exp.SH + pp.c pp_ctl.c pp_sys.c proto.h sv.c toke.c util.c + utils/perldoc.PL vms/config.vms vms/descrip.mms + vms/gen_shrfls.pl vms/genconfig.pl vms/vmsish.h + + Title: "_10+ under OS/2" + From: Ilya Zakharevich + Msg-ID: <199612011107.GAA10805@monk.mps.ohio-state.edu> + Date: Sun, 1 Dec 1996 06:07:19 -0500 (EST) + Files: malloc.c os2/diff.configure + + LIBRARY AND EXTENSIONS + + Title: "{in,ob}structive pods" + From: Tom Christiansen + Msg-ID: <199611301652.JAA24201@toy.perl.com> + Date: Sat, 30 Nov 1996 09:52:57 -0700 + Files: MANIFEST lib/Class/Template.pm lib/File/stat.pm + lib/Net/hostent.pm lib/Net/netent.pm lib/Net/protoent.pm + lib/Net/servent.pm lib/Time/gmtime.pm lib/Time/localtime.pm + lib/Time/tm.pm lib/User/grent.pm lib/User/pwent.pm + + Title: "FileHandle that 'ISA' IO::File" + From: Nick Ing-Simmons + Msg-ID: <199612021718.RAA04416@pluto> + Date: Mon, 2 Dec 1996 17:18:02 GMT + Files: MANIFEST lib/FileHandle.pm + + Title: "Make IO::File::import use its parameters" + From: Chip Salzenberg + Files: ext/IO/lib/IO/File.pm + + Title: "10+ debugger patch" + From: Ilya Zakharevich + Msg-ID: <199612011137.GAA10864@monk.mps.ohio-state.edu> + Date: Sun, 1 Dec 1996 06:37:31 -0500 (EST) + Files: lib/perl5db.pl perl.c pod/perldebug.pod + + Title: "Don't call CORE::close in file handle DESTROY method" + From: Chip Salzenberg + Files: ext/IO/lib/IO/Handle.pm + + Title: "Re: Namespace cleanup: Does SDBM need binary compatibility?" + From: Hallvard B Furuseth + Msg-ID: <199612031445.PAA19056@bombur2.uio.no> + Date: Tue, 3 Dec 1996 15:45:27 +0100 (MET) + Files: ext/SDBM_File/sdbm/pair.h ext/SDBM_File/sdbm/sdbm.3 + + Title: "DB_File 1.07" + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs t/lib/db-btree.t + t/lib/db-recno.t + + Title: "DB_File 1.08" + From: pmarquess@bfsec.bt.co.uk (Paul Marquess) + Files: ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs + + +---------------- Version 5.003_10 ---------------- @@ -20,8 +187,8 @@ valuable changes, but nothing dramatic. From: Chip Salzenberg Files: toke.c - Title: "Make parens optional on [gs]ethost and [gs]et{pw,gr} function - From: Chip Salzenberg + Title: "Make parens optional on [gs]ethost and [gs]et{pw,gr} functions + From: John L. Allen Files: toke.c Title: "Fix syntax error with "$x [0]" and "$x {y}" and "@x {y}"" diff --git a/Configure b/Configure index a7d224c..f9bb490 100755 --- a/Configure +++ b/Configure @@ -338,6 +338,7 @@ d_rename='' d_rmdir='' d_safebcpy='' d_safemcpy='' +d_sanemcmp='' d_select='' d_sem='' d_semctl='' @@ -2429,7 +2430,9 @@ else patchlevel=0 subversion=0 fi -echo "(You have $package $baserev patchlevel $patchlevel subversion $subversion.)" +$echo $n "(You have $package $baserev patchlevel $patchlevel" $c +test 0 -eq "$subversion" || $echo $n " subversion $subversion" $c +echo ".)" : set the prefixup variable, to restore leading tilda escape prefixup='case "$prefixexp" in @@ -2447,9 +2450,13 @@ case "$archlib" in set dflt eval $prefixup ;; - *) version=`LC_ALL=C;export LC_ALL;\ - echo $baserev $patchlevel $subversion | \ - $awk '{print $1 + $2/1000.0 + $3/100000.0}'` + *) if test 0 -eq "$subversion"; then + version=`echo $baserev $patchlevel | \ + $awk '{ printf "%d.%03d\n",$1,$2 }'` + else + version=`echo $baserev $patchlevel $subversion | \ + $awk '{ printf "%d.%03d%02d\n",$1,$2,$3 }'` + fi dflt="$privlib/$archname/$version" ;; esac @@ -6120,6 +6127,7 @@ main() handle = dlopen("./dyna.$dlext", mode) ; if (handle == NULL) { printf ("1\n") ; + fflush (stdout) ; exit(0); } symbol = dlsym(handle, "fred") ; @@ -6128,13 +6136,15 @@ main() symbol = dlsym(handle, "_fred") ; if (symbol == NULL) { printf ("2\n") ; + fflush (stdout) ; exit(0); } printf ("3\n") ; } else printf ("4\n") ; - exit(0); + fflush (stdout) ; + exit(0); } EOM : Call the object file tmp-dyna.o in case dlext=o. @@ -7033,6 +7043,60 @@ $rm -f foo.* safemcpy core set d_safemcpy eval $setvar +: can memcmp be trusted to compare relative magnitude? +val="$undef" +case "$d_memcmp" in +"$define") + echo " " + echo "Checking to see if memcmp() can compare relative magnitude..." >&4 + $cat >foo.c <>foo.c <<'EOCP' +#include + +#ifdef I_MEMORY +# include +#endif +#ifdef I_STDLIB +# include +#endif +#ifdef I_STRING +# include +#else +# include +#endif +#ifdef I_UNISTD +# include /* Needed for NetBSD */ +#endif +main() +{ +char a = -1; +char b = 0; +if ((a < b) && memcmp(&a, &b, 1) < 0) + exit(1); +exit(0); +} +EOCP + if $cc $ccflags $ldflags foo.c -o sanemcmp $libs >/dev/null 2>&1; then + if ./sanemcmp 2>/dev/null; then + echo "Yes, it can." + val="$define" + else + echo "No, it can't (it uses signed chars)." + fi + else + echo "(I can't compile the test program, so we'll assume not...)" + fi + ;; +esac +$rm -f foo.* sanemcmp core +set d_sanemcmp +eval $setvar + : see if select exists set select d_select eval $inlibc @@ -8896,7 +8960,7 @@ main() } EOM echo " " -if $cc $ccflags $ldflags -o ssize ssize.c $libs > /dev/null 2>&1 && +if $cc $ccflags $ldflags -o ssize ssize.c > /dev/null 2>&1 && ./ssize > /dev/null 2>&1 ; then ssizetype=`./ssize` echo "I'll be using $ssizetype for functions returning a byte count." >&4 @@ -9829,6 +9893,7 @@ d_rewinddir='$d_rewinddir' d_rmdir='$d_rmdir' d_safebcpy='$d_safebcpy' d_safemcpy='$d_safemcpy' +d_sanemcmp='$d_sanemcmp' d_seekdir='$d_seekdir' d_select='$d_select' d_sem='$d_sem' diff --git a/EXTERN.h b/EXTERN.h index dedd379..5741fbf 100644 --- a/EXTERN.h +++ b/EXTERN.h @@ -15,12 +15,18 @@ */ #undef EXT #undef dEXT +#undef EXTCONST +#undef dEXTCONST #if defined(VMS) && !defined(__GNUC__) # define EXT globalref # define dEXT globaldef {"$GLOBAL_RW_VARS"} noshare +# define EXTCONST globalref +# define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly #else # define EXT extern # define dEXT +# define EXTCONST extern const +# define dEXTCONST const #endif #undef INIT diff --git a/INSTALL b/INSTALL index 97c72cf..325509b 100644 --- a/INSTALL +++ b/INSTALL @@ -11,6 +11,11 @@ The basic steps to build and install perl5 on a Unix system are: make make test make install + # possibly add these: + (cd /usr/include && h2ph *.h sys/*.h) + cd pod; make html && mv *.html && cd .. + cd pod; make tex && && cd .. + Each of these is explained in further detail below. diff --git a/INTERN.h b/INTERN.h index d89d2e6..76fff3b 100644 --- a/INTERN.h +++ b/INTERN.h @@ -15,12 +15,18 @@ */ #undef EXT #undef dEXT +#undef EXTCONST +#undef dEXTCONST #if defined(VMS) && !defined(__GNUC__) # define EXT globaldef {"$GLOBAL_RW_VARS"} noshare # define dEXT globaldef {"$GLOBAL_RW_VARS"} noshare +# define EXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly +# define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly #else # define EXT # define dEXT +# define EXTCONST const +# define dEXTCONST const #endif #undef INIT diff --git a/MANIFEST b/MANIFEST index 859da3c..6c267a1 100644 --- a/MANIFEST +++ b/MANIFEST @@ -100,9 +100,6 @@ ext/DynaLoader/dlutils.c Dynamic loader utilities for dl_*.xs files ext/Fcntl/Fcntl.pm Fcntl extension Perl module ext/Fcntl/Fcntl.xs Fcntl extension external subroutines ext/Fcntl/Makefile.PL Fcntl extension makefile writer -ext/FileHandle/FileHandle.pm FileHandle extension Perl module -ext/FileHandle/FileHandle.xs FileHandle extension external subroutines -ext/FileHandle/Makefile.PL FileHandle extension makefile writer ext/GDBM_File/GDBM_File.pm GDBM extension Perl module ext/GDBM_File/GDBM_File.xs GDBM extension external subroutines ext/GDBM_File/Makefile.PL GDBM extension makefile writer @@ -240,8 +237,8 @@ hints/next_3_0.sh Hints for named architecture hints/next_4.sh Hints for named architecture hints/opus.sh Hints for named architecture hints/os2.sh Hints for named architecture -hints/qnx.sh Hints for named architecture hints/powerux.sh Hints for named architecture +hints/qnx.sh Hints for named architecture hints/sco.sh Hints for named architecture hints/sco_2_3_0.sh Hints for named architecture hints/sco_2_3_1.sh Hints for named architecture @@ -273,6 +270,7 @@ lib/AutoLoader.pm Autoloader base class lib/AutoSplit.pm A module to split up autoload functions lib/Benchmark.pm A module to time pieces of code and such lib/Carp.pm Error message base class +lib/Class/Template.pm Structure/member template builder; makes nested types lib/Cwd.pm Various cwd routines (getcwd, fastcwd, chdir) lib/Devel/SelfStubber.pm Generate stubs for SelfLoader.pm lib/DirHandle.pm like FileHandle only for directories @@ -298,7 +296,9 @@ lib/File/CheckTree.pm Perl module supporting wholesale file mode validation lib/File/Copy.pm Emulation of cp command lib/File/Find.pm Routines to do a find lib/File/Path.pm A module to do things like `mkdir -p' and `rm -r' +lib/File/stat.pm Object-oriented wrapper around CORE::stat lib/FileCache.pm Keep more files open than the system permits +lib/FileHandle.pm Backward-compatible front end to IO extension lib/FindBin.pm Find name of currently executing program lib/Getopt/Long.pm A module to fetch command options (GetOptions) lib/Getopt/Std.pm A module to fetch command options (getopt, getopts) @@ -309,6 +309,10 @@ lib/Math/BigFloat.pm An arbitrary precision floating-point arithmetic package lib/Math/BigInt.pm An arbitrary precision integer arithmetic package lib/Math/Complex.pm A Complex package lib/Net/Ping.pm Ping methods +lib/Net/hostent.pm Object-oriented wrapper around CORE::gethost* +lib/Net/netent.pm Object-oriented wrapper around CORE::getnet* +lib/Net/protoent.pm Object-oriented wrapper around CORE::getproto* +lib/Net/servent.pm Object-oriented wrapper around CORE::getserv* lib/Pod/Functions.pm used by pod/splitpod lib/Pod/Text.pm Convert POD data to formatted ASCII text lib/Search/Dict.pm A module to do binary search on dictionaries @@ -331,7 +335,12 @@ lib/Tie/Hash.pm Base class for tied hashes lib/Tie/Scalar.pm Base class for tied scalars lib/Tie/SubstrHash.pm Compact hash for known key, value and table size lib/Time/Local.pm Reverse translation of localtime, gmtime +lib/Time/gmtime.pm Object-oriented wrapper around CORE::gmtime +lib/Time/localtime.pm Object-oriented wrapper around CORE::localtime +lib/Time/tm.pm Perl implementation of "struct tm" for {gm,local}time lib/UNIVERSAL.pm Base class for ALL classes. +lib/User/grent.pm Object-oriented wrapper around CORE::getgr* +lib/User/pwent.pm Object-oriented wrapper around CORE::getpw* lib/abbrev.pl An abbreviation table builder lib/assert.pl assertion and panic with stack trace lib/bigfloat.pl An arbitrary precision floating point package diff --git a/Makefile.SH b/Makefile.SH index 1a2d67d..81d6589 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -285,7 +285,7 @@ quantperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs # has been invoked correctly. suidperl: $& sperl$(OBJ_EXT) perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs - $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o suidperl perlmain$(OBJ_EXT) sperl$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) `cat ext.libs` $(libs) + $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o suidperl perlmain$(OBJ_EXT) sperl$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LIBPERL) `cat ext.libs` $(libs) !NO!SUBS! diff --git a/config_H b/config_H index dec1e75..6146ce8 100644 --- a/config_H +++ b/config_H @@ -536,6 +536,14 @@ */ /*#define HAS_SAFE_MEMCPY / **/ +/* HAS_SANE_MEMCMP: + * This symbol, if defined, indicates that the memcmp() routine is + * available to compare memory blocks for relative magnitude. If this + * symbol is not defined, and if HAS_MEMCMP is defined, then memcmp() + * may be used only to compare memory blocks for equality. + */ +/*#define HAS_SANE_MEMCMP / **/ + /* HAS_SELECT: * This symbol, if defined, indicates that the select routine is * available to select active file descriptors. If the timeout field diff --git a/config_h.SH b/config_h.SH index 0a8bc62..d2ff19c 100755 --- a/config_h.SH +++ b/config_h.SH @@ -550,6 +550,14 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_safemcpy HAS_SAFE_MEMCPY /**/ +/* HAS_SANE_MEMCMP: + * This symbol, if defined, indicates that the memcmp() routine is + * available to compare memory blocks for relative magnitude. If this + * symbol is not defined, and if HAS_MEMCMP is defined, then memcmp() + * may be used only to compare memory blocks for equality. + */ +#$d_sanemcmp HAS_SANE_MEMCMP /**/ + /* HAS_SELECT: * This symbol, if defined, indicates that the select routine is * available to select active file descriptors. If the timeout field diff --git a/doio.c b/doio.c index 38f7c0d..69cc891 100644 --- a/doio.c +++ b/doio.c @@ -742,56 +742,6 @@ Off_t length; /* length to set file to */ } #endif /* F_FREESP */ -I32 -looks_like_number(sv) -SV *sv; -{ - register char *s; - register char *send; - - if (!SvPOK(sv)) { - STRLEN len; - if (!SvPOKp(sv)) - return TRUE; - s = SvPV(sv, len); - send = s + len; - } - else { - s = SvPVX(sv); - send = s + SvCUR(sv); - } - while (isSPACE(*s)) - s++; - if (s >= send) - return FALSE; - if (*s == '+' || *s == '-') - s++; - while (isDIGIT(*s)) - s++; - if (s == send) - return TRUE; - if (*s == '.') - s++; - else if (s == SvPVX(sv)) - return FALSE; - while (isDIGIT(*s)) - s++; - if (s == send) - return TRUE; - if (*s == 'e' || *s == 'E') { - s++; - if (*s == '+' || *s == '-') - s++; - while (isDIGIT(*s)) - s++; - } - while (isSPACE(*s)) - s++; - if (s >= send) - return TRUE; - return FALSE; -} - bool do_print(sv,fp) register SV *sv; diff --git a/doop.c b/doop.c index dd162de..836027e 100644 --- a/doop.c +++ b/doop.c @@ -18,14 +18,6 @@ #include #endif -#ifdef BUGGY_MSC - #pragma function(memcmp) -#endif /* BUGGY_MSC */ - -#ifdef BUGGY_MSC - #pragma intrinsic(memcmp) -#endif /* BUGGY_MSC */ - I32 do_trans(sv,arg) SV *sv; @@ -507,7 +499,7 @@ register SV *sv; goto nope; len -= rslen - 1; s -= rslen - 1; - if (memcmp(s, rsptr, rslen)) + if (memNE(s, rsptr, rslen)) goto nope; count += rslen; } diff --git a/embed.pl b/embed.pl index c535fe0..a1e77db 100755 --- a/embed.pl +++ b/embed.pl @@ -1,5 +1,6 @@ #!/usr/bin/perl +unlink "embed.h"; open(EM, ">embed.h") || die "Can't create embed.h: $!\n"; print EM <<'END'; diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm index f62de2e..ea77c32 100644 --- a/ext/DB_File/DB_File.pm +++ b/ext/DB_File/DB_File.pm @@ -1,8 +1,13 @@ # DB_File.pm -- Perl 5 interface to Berkeley DB # # written by Paul Marquess (pmarquess@bfsec.bt.co.uk) -# last modified 27th Nov 1996 -# version 1.06 +# last modified 3rd Dec 1996 +# version 1.08 +# +# Copyright (c) 1995, 1996 Paul Marquess. All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. + package DB_File::HASHINFO ; @@ -26,13 +31,11 @@ sub TIEHASH { my $pkg = shift ; - bless { 'bsize' => 0, - 'ffactor' => 0, - 'nelem' => 0, - 'cachesize' => 0, - 'hash' => undef, - 'lorder' => 0, - }, $pkg ; + bless { VALID => { map {$_, 1} + qw( bsize ffactor nelem cachesize hash lorder) + }, + GOT => {} + }, $pkg ; } @@ -41,7 +44,7 @@ sub FETCH my $self = shift ; my $key = shift ; - return $self->{$key} if exists $self->{$key} ; + return $self->{GOT}{$key} if exists $self->{VALID}{$key} ; my $pkg = ref $self ; croak "${pkg}::FETCH - Unknown element '$key'" ; @@ -54,9 +57,9 @@ sub STORE my $key = shift ; my $value = shift ; - if ( exists $self->{$key} ) + if ( exists $self->{VALID}{$key} ) { - $self->{$key} = $value ; + $self->{GOT}{$key} = $value ; return ; } @@ -69,9 +72,9 @@ sub DELETE my $self = shift ; my $key = shift ; - if ( exists $self->{$key} ) + if ( exists $self->{VALID}{$key} ) { - delete $self->{$key} ; + delete $self->{GOT}{$key} ; return ; } @@ -84,7 +87,7 @@ sub EXISTS my $self = shift ; my $key = shift ; - exists $self->{$key} ; + exists $self->{VALID}{$key} ; } sub NotHere @@ -110,14 +113,11 @@ sub TIEHASH { my $pkg = shift ; - bless { 'bval' => 0, - 'cachesize' => 0, - 'psize' => 0, - 'flags' => 0, - 'lorder' => 0, - 'reclen' => 0, - 'bfname' => "", - }, $pkg ; + bless { VALID => { map {$_, 1} + qw( bval cachesize psize flags lorder reclen bfname ) + }, + GOT => {}, + }, $pkg ; } package DB_File::BTREEINFO ; @@ -130,15 +130,12 @@ sub TIEHASH { my $pkg = shift ; - bless { 'flags' => 0, - 'cachesize' => 0, - 'maxkeypage' => 0, - 'minkeypage' => 0, - 'psize' => 0, - 'compare' => undef, - 'prefix' => undef, - 'lorder' => 0, - }, $pkg ; + bless { VALID => { map {$_, 1} + qw( flags cachesize maxkeypage minkeypage psize + compare prefix lorder ) + }, + GOT => {}, + }, $pkg ; } @@ -149,7 +146,7 @@ use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO) ; use Carp; -$VERSION = "1.06" ; +$VERSION = "1.08" ; #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE; $DB_BTREE = new DB_File::BTREEINFO ; @@ -462,7 +459,7 @@ values when you only want to change one. Here is an example: $a->{'cachesize'} = 12345 ; tie %y, 'DB_File', "filename", $flags, 0777, $a ; -A few of the values need extra discussion here. When used, the C +A few of the options need extra discussion here. When used, the C equivalent of the keys C, C and C store pointers to C functions. In B these keys are used to store references to Perl subs. Below are templates for each of the subs: @@ -497,6 +494,9 @@ to Perl subs. Below are templates for each of the subs: See L for an example of using the C template. +If you are using the DB_RECNO interface and you intend making use of +C, you should check out L. + =head2 Default Parameters It is possible to omit some or all of the final 4 parameters in the @@ -893,6 +893,33 @@ negative indexes. The index -1 refers to the last element of the array, -2 the second last, and so on. Attempting to access an element before the start of the array will raise a fatal run-time error. +=head2 The bval option + +The operation of the bval option warrants some discussion. Here is the +definition of bval from the Berkeley DB 1.85 recno manual page: + + The delimiting byte to be used to mark the end of a + record for variable-length records, and the pad charac- + ter for fixed-length records. If no value is speci- + fied, newlines (``\n'') are used to mark the end of + variable-length records and fixed-length records are + padded with spaces. + +The second sentence is wrong. In actual fact bval will only default to +C<"\n"> when the openinfo parameter in dbopen is NULL. If a non-NULL +openinfo parameter is used at all, the value that happens to be in bval +will be used. That means you always have to specify bval when making +use of any of the options in the openinfo parameter. This documentation +error will be fixed in the next release of Berkeley DB. + +That clarifies the situation with regards Berkeley DB itself. What +about B? Well, the behavior defined in the quote above is +quite useful, so B conforms it. + +That means that you can specify other options (e.g. cachesize) and +still have bval default to C<"\n"> for variable length records, and +space for fixed length records. + =head2 A Simple Example Here is a simple example that uses RECNO. @@ -1522,6 +1549,14 @@ is installed. Minor namespace cleanup: Localized C. +=item 1.07 + +Fixed bug with RECNO, where bval wasn't defaulting to "\n". + +=item 1.08 + +Documented operation of bval. + =back =head1 BUGS diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index f7dc378..821eaae 100644 --- a/ext/DB_File/DB_File.xs +++ b/ext/DB_File/DB_File.xs @@ -3,11 +3,15 @@ DB_File.xs -- Perl 5 interface to Berkeley DB written by Paul Marquess (pmarquess@bfsec.bt.co.uk) - last modified 27th Nov 1996 - version 1.06 + last modified 3rd Dec 1996 + version 1.08 All comments/suggestions/problems are welcome + Copyright (c) 1995, 1996 Paul Marquess. All rights reserved. + This program is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + Changes: 0.1 - Initial Release 0.2 - No longer bombs out if dbopen returns an error. @@ -28,6 +32,8 @@ 1.05 - Added logic to allow prefix & hash types to be specified via Makefile.PL 1.06 - Minor namespace cleanup: Localized PrintBtree. + 1.07 - Fixed bug with RECNO, where bval wasn't defaulting to "\n". + 1.08 - No change to DB_File.xs */ @@ -270,7 +276,7 @@ RECNOINFO * recno ; printf (" psize = %d\n", recno->psize) ; printf (" lorder = %d\n", recno->lorder) ; printf (" reclen = %d\n", recno->reclen) ; - printf (" bval = %d\n", recno->bval) ; + printf (" bval = %d 0x%x\n", recno->bval, recno->bval) ; printf (" bfname = %d [%s]\n", recno->bfname, recno->bfname) ; } @@ -361,7 +367,11 @@ SV * sv ; if (! SvROK(sv) ) croak ("type parameter is not a reference") ; - action = (HV*)SvRV(sv); + svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ; + if (svp && SvOK(*svp)) + action = (HV*) SvRV(*svp) ; + else + croak("internal error") ; if (sv_isa(sv, "DB_File::HASHINFO")) { @@ -476,10 +486,12 @@ SV * sv ; } svp = hv_fetch(action, "bfname", 6, FALSE); - if (svp) { + if (svp && SvOK(*svp)) { char * ptr = SvPV(*svp,na) ; - info->recno.bfname = (char*) na ? ptr : 0 ; + info->recno.bfname = (char*) na ? ptr : NULL ; } + else + info->recno.bfname = NULL ; PrintRecno(info) ; } diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index e4aa293..e5f9b2f 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -2736,7 +2736,7 @@ setlocale(category, locale = 0) CODE: RETVAL = setlocale(category, locale); if (RETVAL) { -#ifdef LC_CTYPE +#ifdef USE_LOCALE_CTYPE if (category == LC_CTYPE #ifdef LC_ALL || category == LC_ALL @@ -2752,8 +2752,8 @@ setlocale(category, locale = 0) newctype = RETVAL; perl_new_ctype(newctype); } -#endif /* LC_CTYPE */ -#ifdef LC_COLLATE +#endif /* USE_LOCALE_CTYPE */ +#ifdef USE_LOCALE_COLLATE if (category == LC_COLLATE #ifdef LC_ALL || category == LC_ALL @@ -2769,8 +2769,8 @@ setlocale(category, locale = 0) newcoll = RETVAL; perl_new_collate(newcoll); } -#endif /* LC_COLLATE */ -#ifdef LC_NUMERIC +#endif /* USE_LOCALE_COLLATE */ +#ifdef USE_LOCALE_NUMERIC if (category == LC_NUMERIC #ifdef LC_ALL || category == LC_ALL @@ -2786,7 +2786,7 @@ setlocale(category, locale = 0) newnum = RETVAL; perl_new_numeric(newnum); } -#endif /* LC_NUMERIC */ +#endif /* USE_LOCALE_NUMERIC */ } OUTPUT: RETVAL @@ -3102,7 +3102,7 @@ strtod(str) double num; char *unparsed; PPCODE: - NUMERIC_LOCAL(); + SET_NUMERIC_LOCAL(); num = strtod(str, &unparsed); PUSHs(sv_2mortal(newSVnv(num))); if (GIMME == G_ARRAY) { diff --git a/ext/SDBM_File/sdbm/pair.c b/ext/SDBM_File/sdbm/pair.c index a02c73f..23bbfe9 100644 --- a/ext/SDBM_File/sdbm/pair.c +++ b/ext/SDBM_File/sdbm/pair.c @@ -231,7 +231,7 @@ register int siz; for (i = 1; i < n; i += 2) { if (siz == off - ino[i] && - memcmp(key, pag + ino[i], siz) == 0) + memEQ(key, pag + ino[i], siz)) return i; off = ino[i + 1]; } diff --git a/ext/SDBM_File/sdbm/sdbm.h b/ext/SDBM_File/sdbm/sdbm.h index 11967ec..c9b28f5 100644 --- a/ext/SDBM_File/sdbm/sdbm.h +++ b/ext/SDBM_File/sdbm/sdbm.h @@ -185,10 +185,6 @@ extern long sdbm_hash proto((char *, int)); #include #endif -#if defined(mips) && defined(ultrix) && !defined(__STDC__) -# undef HAS_MEMCMP -#endif - #ifdef HAS_MEMCPY # if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) # ifndef memcpy @@ -222,24 +218,44 @@ extern long sdbm_hash proto((char *, int)); # endif #endif /* HAS_MEMSET */ -#ifdef HAS_MEMCMP +#if defined(mips) && defined(ultrix) && !defined(__STDC__) +# undef HAS_MEMCMP +#endif + +#if defined(HAS_MEMCMP) && defined(HAS_SANE_MEMCMP) # if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) # ifndef memcmp extern int memcmp _((char*, char*, int)); # endif # endif +# ifdef BUGGY_MSC + # pragma function(memcmp) +# endif #else # ifndef memcmp -# define memcmp my_memcmp +# /* maybe we should have included the full embedding header... */ +# ifdef NO_EMBED +# define memcmp my_memcmp +# else +# define memcmp Perl_my_memcmp +# endif + extern int memcmp _((char*, char*, int)); # endif #endif /* HAS_MEMCMP */ -/* we prefer bcmp slightly for comparisons that don't care about ordering */ #ifndef HAS_BCMP # ifndef bcmp # define bcmp(s1,s2,l) memcmp(s1,s2,l) # endif -#endif /* HAS_BCMP */ +#endif /* !HAS_BCMP */ + +#ifdef HAS_MEMCMP +# define memNE(s1,s2,l) (memcmp(s1,s2,l)) +# define memEQ(s1,s2,l) (!memcmp(s1,s2,l)) +#else +# define memNE(s1,s2,l) (bcmp(s1,s2,l)) +# define memEQ(s1,s2,l) (!bcmp(s1,s2,l)) +#endif #ifdef I_NETINET_IN # include diff --git a/handy.h b/handy.h index b6350a9..056bf2c 100644 --- a/handy.h +++ b/handy.h @@ -124,6 +124,14 @@ typedef unsigned short U16; #define strnNE(s1,s2,l) (strncmp(s1,s2,l)) #define strnEQ(s1,s2,l) (!strncmp(s1,s2,l)) +#ifdef HAS_MEMCMP +# define memNE(s1,s2,l) (memcmp(s1,s2,l)) +# define memEQ(s1,s2,l) (!memcmp(s1,s2,l)) +#else +# define memNE(s1,s2,l) (bcmp(s1,s2,l)) +# define memEQ(s1,s2,l) (!bcmp(s1,s2,l)) +#endif + /* * Character classes. * diff --git a/hv.c b/hv.c index b25c2e2..0650123 100644 --- a/hv.c +++ b/hv.c @@ -127,7 +127,7 @@ I32 lval; continue; if (HeKLEN(entry) != klen) continue; - if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; return &HeVAL(entry); } @@ -207,7 +207,7 @@ register U32 hash; continue; if (HeKLEN(entry) != klen) continue; - if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; return entry; } @@ -271,7 +271,7 @@ register U32 hash; continue; if (HeKLEN(entry) != klen) continue; - if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; SvREFCNT_dec(HeVAL(entry)); HeVAL(entry) = val; @@ -344,7 +344,7 @@ register U32 hash; continue; if (HeKLEN(entry) != klen) continue; - if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; SvREFCNT_dec(HeVAL(entry)); HeVAL(entry) = val; @@ -411,7 +411,7 @@ I32 flags; continue; if (HeKLEN(entry) != klen) continue; - if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; *oentry = HeNEXT(entry); if (i && !*oentry) @@ -473,7 +473,7 @@ U32 hash; continue; if (HeKLEN(entry) != klen) continue; - if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; *oentry = HeNEXT(entry); if (i && !*oentry) @@ -527,7 +527,7 @@ U32 klen; continue; if (HeKLEN(entry) != klen) continue; - if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; return TRUE; } @@ -574,7 +574,7 @@ U32 hash; continue; if (HeKLEN(entry) != klen) continue; - if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ continue; return TRUE; } @@ -1045,7 +1045,7 @@ U32 hash; continue; if (HeKLEN(entry) != len) continue; - if (memcmp(HeKEY(entry),str,len)) /* is this it? */ + if (memNE(HeKEY(entry),str,len)) /* is this it? */ continue; found = 1; if (--HeVAL(entry) == Nullsv) { @@ -1092,7 +1092,7 @@ register U32 hash; continue; if (HeKLEN(entry) != len) continue; - if (memcmp(HeKEY(entry),str,len)) /* is this it? */ + if (memNE(HeKEY(entry),str,len)) /* is this it? */ continue; found = 1; break; diff --git a/hv.h b/hv.h index c8d8be6..5256eac 100644 --- a/hv.h +++ b/hv.h @@ -111,7 +111,7 @@ struct xpvhv { #define HeSVKEY_set(he,sv) (HeKEY_sv(he) = sv) #define Nullhek Null(HEK*) -#define HEK_BASESIZE OFFSETOF(HEK, hek_key) +#define HEK_BASESIZE OFFSETOF(HEK, hek_key[0]) #define HEK_HASH(hek) (hek)->hek_hash #define HEK_LEN(hek) (hek)->hek_len #define HEK_KEY(hek) (hek)->hek_key diff --git a/installperl b/installperl index a9082df..f4e6895 100755 --- a/installperl +++ b/installperl @@ -73,6 +73,7 @@ if ($d_dosuid && $>) { die "You must run as root to install suidperl\n"; } &safe_unlink("$installbin/perl$ver$exe_ext"); &cmd("cp perl$exe_ext $installbin/perl$ver$exe_ext"); +&chmod(0755, "$installbin/perl$ver$exe_ext"); &safe_unlink("$installbin/sperl$ver$exe_ext"); if ($d_dosuid) { diff --git a/keywords.pl b/keywords.pl index 086a109..595e875 100755 --- a/keywords.pl +++ b/keywords.pl @@ -1,5 +1,6 @@ #!/usr/bin/perl +unlink "keywords.h"; open(KW, ">keywords.h") || die "Can't create keywords.h: $!\n"; select KW; diff --git a/lib/Class/Template.pm b/lib/Class/Template.pm new file mode 100644 index 0000000..e45a5d3 --- /dev/null +++ b/lib/Class/Template.pm @@ -0,0 +1,241 @@ +package Class::Template; +require 5.000; +require Exporter; + +@ISA = qw(Exporter); +@EXPORT = qw(members struct); +use strict; + +# Template.pm --- struct/member template builder +# 12mar95 +# Dean Roehrich +# +# changes/bugs fixed since 28nov94 version: +# - podified +# changes/bugs fixed since 21nov94 version: +# - Fixed examples. +# changes/bugs fixed since 02sep94 version: +# - Moved to Class::Template. +# changes/bugs fixed since 20feb94 version: +# - Updated to be a more proper module. +# - Added "use strict". +# - Bug in build_methods, was using @var when @$var needed. +# - Now using my() rather than local(). +# +# Uses perl5 classes to create nested data types. +# This is offered as one implementation of Tom Christiansen's "structs.pl" +# idea. + +=head1 NAME + +Class::Template - struct/member template builder + +=head1 EXAMPLES + +=item * Example 1 + + use Class::Template; + + struct( rusage => { + ru_utime => timeval, + ru_stime => timeval, + }); + + struct( timeval => [ + tv_secs => '$', + tv_usecs => '$', + ]); + + my $s = new rusage; + +=item * Example 2 + + package OBJ; + use Class::Template; + + members OBJ { + 'a' => '$', + 'b' => '$', + }; + + members OBJ2 { + 'd' => '@', + 'c' => '$', + }; + + package OBJ2; @ISA = (OBJ); + + sub new { + my $r = InitMembers( &OBJ::InitMembers() ); + bless $r; + } + +=head1 NOTES + +Use '%' if the member should point to an anonymous hash. Use '@' if the +member should point to an anonymous array. + +When using % and @ the method requires one argument for the key or index +into the hash or array. + +Prefix the %, @, or $ with '*' to indicate you want to retrieve pointers to +the values rather than the values themselves. + +=cut + +Var: { + $Class::Template::print = 0; + sub printem { $Class::Template::print++ } +} + + +sub struct { + my( $struct, $ref ) = @_; + my @methods = (); + my %refs = (); + my %arrays = (); + my %hashes = (); + my $out = ''; + + $out = "{\n package $struct;\n sub new {\n"; + parse_fields( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes, 0 ); + $out .= " bless \$r;\n }\n"; + build_methods( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes ); + $out .= "}\n1;\n"; + + ( $Class::Template::print ) ? print( $out ) : eval $out; +} + +sub members { + my( $pkg, $ref ) = @_; + my @methods = (); + my %refs = (); + my %arrays = (); + my %hashes = (); + my $out = ''; + + $out = "{\n package $pkg;\n sub InitMembers {\n"; + parse_fields( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes, 1 ); + $out .= " bless \$r;\n }\n"; + build_methods( $ref, \$out, \@methods, \%refs, \%arrays, \%hashes ); + $out .= "}\n1;\n"; + + ( $Class::Template::print ) ? print( $out ) : eval $out; +} + + +sub parse_fields { + my( $ref, $out, $methods, $refs, $arrays, $hashes, $member ) = @_; + my $type = ref $ref; + my @keys; + my $val; + my $cnt = 0; + my $idx = 0; + my( $cmt, $n ); + + if( $type eq 'HASH' ){ + if( $member ){ + $$out .= " my(\$r) = \@_ ? shift : {};\n"; + } + else{ + $$out .= " my(\$r) = {};\n"; + } + @keys = keys %$ref; + foreach (@keys){ + $val = $ref->{$_}; + if( $val =~ /^\*(.)/ ){ + $refs->{$_}++; + $val = $1; + } + if( $val eq '@' ){ + $$out .= " \$r->{'$_'} = [];\n"; + $arrays->{$_}++; + } + elsif( $val eq '%' ){ + $$out .= " \$r->{'$_'} = {};\n"; + $hashes->{$_}++; + } + elsif( $val ne '$' ){ + $$out .= " \$r->{'$_'} = \&${val}::new();\n"; + } + else{ + $$out .= " \$r->{'$_'} = undef;\n"; + } + push( @$methods, $_ ); + } + } + elsif( $type eq 'ARRAY' ){ + if( $member ){ + $$out .= " my(\$r) = \@_ ? shift : [];\n"; + } + else{ + $$out .= " my(\$r) = [];\n"; + } + while( $idx < @$ref ){ + $n = $ref->[$idx]; + push( @$methods, $n ); + $val = $ref->[$idx+1]; + $cmt = "# $n"; + if( $val =~ /^\*(.)/ ){ + $refs->{$n}++; + $val = $1; + } + if( $val eq '@' ){ + $$out .= " \$r->[$cnt] = []; $cmt\n"; + $arrays->{$n}++; + } + elsif( $val eq '%' ){ + $$out .= " \$r->[$cnt] = {}; $cmt\n"; + $hashes->{$n}++; + } + elsif( $val ne '$' ){ + $$out .= " \$r->[$cnt] = \&${val}::new();\n"; + } + else{ + $$out .= " \$r->[$cnt] = undef; $cmt\n"; + } + ++$cnt; + $idx += 2; + } + } +} + + +sub build_methods { + my( $ref, $out, $methods, $refs, $arrays, $hashes ) = @_; + my $type = ref $ref; + my $elem = ''; + my $cnt = 0; + my( $pre, $pst, $cmt, $idx ); + + foreach (@$methods){ + $pre = $pst = $cmt = $idx = ''; + if( defined $refs->{$_} ){ + $pre = "\\("; + $pst = ")"; + $cmt = " # returns ref"; + } + $$out .= " sub $_ {$cmt\n my \$r = shift;\n"; + if( $type eq 'ARRAY' ){ + $elem = "[$cnt]"; + ++$cnt; + } + elsif( $type eq 'HASH' ){ + $elem = "{'$_'}"; + } + if( defined $arrays->{$_} ){ + $$out .= " my \$i;\n"; + $$out .= " \@_ ? (\$i = shift) : return \$r->$elem;\n"; + $idx = "->[\$i]"; + } + elsif( defined $hashes->{$_} ){ + $$out .= " my \$i;\n"; + $$out .= " \@_ ? (\$i = shift) : return \$r->$elem;\n"; + $idx = "->{\$i}"; + } + $$out .= " \@_ ? (\$r->$elem$idx = shift) : $pre\$r->$elem$idx$pst;\n"; + $$out .= " }\n"; + } +} + +1; diff --git a/lib/ExtUtils/Embed.pm b/lib/ExtUtils/Embed.pm index c4a3c68..fb2664c 100644 --- a/lib/ExtUtils/Embed.pm +++ b/lib/ExtUtils/Embed.pm @@ -1,4 +1,4 @@ -# $Id: Embed.pm,v 1.18 1996/07/02 13:48:17 dougm Exp $ +# $Id: Embed.pm,v 1.21 1996/11/29 17:26:23 dougm Exp $ require 5.002; package ExtUtils::Embed; @@ -17,7 +17,7 @@ use vars qw(@ISA @EXPORT $VERSION ); use strict; -$VERSION = sprintf("%d.%02d", q$Revision: 1.18 $ =~ /(\d+)\.(\d+)/); +$VERSION = sprintf("%d.%02d", q$Revision: 1.21 $ =~ /(\d+)\.(\d+)/); #for the namespace change $Devel::embed::VERSION = "99.99"; @@ -201,7 +201,7 @@ sub ldopts { my($extralibs, $bsloadlibs, $ldloadlibs, $ld_run_path) = $MM->ext(join ' ', - $MM->catdir("-L$Config{archlib}", "CORE"), " -lperl", + $MM->catdir("-L$Config{archlibexp}", "CORE"), " -lperl", @potential_libs); my $ld_or_bs = $bsloadlibs || $ldloadlibs; @@ -419,11 +419,11 @@ conflict, the additional arguments will be part of the output. For including perl header files this function simply prints: - -I$Config{archlib}/CORE + -I$Config{archlibexp}/CORE So, rather than having to say: - perl -MConfig -e 'print "-I$Config{archlib}/CORE"' + perl -MConfig -e 'print "-I$Config{archlibexp}/CORE"' Just say: diff --git a/lib/File/Path.pm b/lib/File/Path.pm index 62f3b50..2e35303 100644 --- a/lib/File/Path.pm +++ b/lib/File/Path.pm @@ -156,7 +156,7 @@ sub rmtree { print "unlink $root\n" if $verbose; while (-e $root || -l $root) { # delete all versions under VMS (unlink($root) && ++$count) - or carp "Can't unlink file $root: $!"; + or croak "Can't unlink file $root: $!"; } } } diff --git a/lib/File/stat.pm b/lib/File/stat.pm new file mode 100644 index 0000000..581fbf3 --- /dev/null +++ b/lib/File/stat.pm @@ -0,0 +1,111 @@ +package File::stat; +use strict; + +BEGIN { + use Exporter (); + use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + @ISA = qw(Exporter); + @EXPORT = qw(stat lstat); + @EXPORT_OK = qw( $st_dev $st_ino $st_mode + $st_nlink $st_uid $st_gid + $st_rdev $st_size + $st_atime $st_mtime $st_ctime + $st_blksize $st_blocks + ); + %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); +} +use vars @EXPORT_OK; + +use Class::Template qw(struct); +struct 'File::stat' => [ + map { $_ => '$' } qw{ + dev ino mode nlink uid gid rdev size + atime mtime ctime blksize blocks + } +]; + +sub populate (@) { + return unless @_; + my $stob = new(); + @$stob = ( + $st_dev, $st_ino, $st_mode, $st_nlink, $st_uid, $st_gid, $st_rdev, + $st_size, $st_atime, $st_mtime, $st_ctime, $st_blksize, $st_blocks ) + = @_; + return $stob; +} + +sub lstat (*) { populate(CORE::lstat(shift)) } + +sub stat ($) { + my $arg = shift; + my $st = populate(CORE::stat $arg); + return $st if $st; + no strict 'refs'; + require Symbol; + return populate(CORE::stat \*{Symbol::qualify($arg)}); +} + +1; +__END__ + +=head1 NAME + +File::stat.pm - by-name interface to Perl's built-in stat() functions + +=head1 SYNOPSIS + + use File::stat; + $st = stat($file) or die "No $file: $!"; + if ( ($st->mode & 0111) && $st->nlink > 1) ) { + print "$file is executable with lotsa links\n"; + } + + use File::stat qw(:FIELDS); + stat($file) or die "No $file: $!"; + if ( ($st_mode & 0111) && $st_nlink > 1) ) { + print "$file is executable with lotsa links\n"; + } + +=head1 DESCRIPTION + +This module's default exports override the core stat() +and lstat() functions, replacing them with versions that return +"File::stat" objects. This object has methods that +return the similarly named structure field name from the +stat(2) function; namely, +dev, +ino, +mode, +nlink, +uid, +gid, +rdev, +size, +atime, +mtime, +ctime, +blksize, +and +blocks. + +You may also import all the structure fields directly into your namespace +as regular variables using the :FIELDS import tag. (Note that this still +overrides your stat() and lstat() functions.) Access these fields as +variables named with a preceding C in front their method names. +Thus, C<$stat_obj-Edev()> corresponds to $st_dev if you import +the fields. + +To access this functionality without the core overrides, +pass the C an empty import list, and then access +function functions with their full qualified names. +On the other hand, the built-ins are still available +via the C pseudo-package. + +=head1 NOTE + +While this class is currently implemented using the Class::Template +module to build a struct-like class, you shouldn't rely upon this. + +=head1 AUTHOR + +Tom Christiansen diff --git a/lib/FileHandle.pm b/lib/FileHandle.pm new file mode 100644 index 0000000..b215147 --- /dev/null +++ b/lib/FileHandle.pm @@ -0,0 +1,227 @@ +package FileHandle; + +require 5.003; +use strict; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); + +$VERSION = "2.00"; + +require IO::File; +@ISA = qw(IO::File); + +@EXPORT = qw(_IOFBF _IOLBF _IONBF); + +@EXPORT_OK = qw( + pipe + + autoflush + output_field_separator + output_record_separator + input_record_separator + input_line_number + format_page_number + format_lines_per_page + format_lines_left + format_name + format_top_name + format_line_break_characters + format_formfeed + + print + printf + getline + getlines +); + +# +# Everything we're willing to export, we must first import. +# +import IO::Handle grep { !defined(&$_) } @EXPORT, @EXPORT_OK; + +# +# Specialized importer for Fcntl magic. +# +sub import { + my $pkg = shift; + my $callpkg = caller; + Exporter::export $pkg, $callpkg, @_; + + # + # If the Fcntl extension is available, + # export its constants. + # + eval { + require Fcntl; + Exporter::export 'Fcntl', $callpkg; + }; +} + +################################################ +# This is the only exported function we define; +# the rest come from other classes. +# + +sub pipe { + my $r = new IO::Handle; + my $w = new IO::Handle; + CORE::pipe($r, $w) or return undef; + ($r, $w); +} + +1; + +__END__ + +=head1 NAME + +FileHandle - supply object methods for filehandles + +=head1 SYNOPSIS + + use FileHandle; + + $fh = new FileHandle; + if ($fh->open "< file") { + print <$fh>; + $fh->close; + } + + $fh = new FileHandle "> FOO"; + if (defined $fh) { + print $fh "bar\n"; + $fh->close; + } + + $fh = new FileHandle "file", "r"; + if (defined $fh) { + print <$fh>; + undef $fh; # automatically closes the file + } + + $fh = new FileHandle "file", O_WRONLY|O_APPEND; + if (defined $fh) { + print $fh "corge\n"; + undef $fh; # automatically closes the file + } + + $pos = $fh->getpos; + $fh->setpos $pos; + + $fh->setvbuf($buffer_var, _IOLBF, 1024); + + ($readfh, $writefh) = FileHandle::pipe; + + autoflush STDOUT 1; + +=head1 DESCRIPTION + +NOTE: This class is now a front-end to the IO::* classes. + +C creates a C, which is a reference to a +newly created symbol (see the C package). If it receives any +parameters, they are passed to C; if the open fails, +the C object is destroyed. Otherwise, it is returned to +the caller. + +C creates a C like C does. +It requires two parameters, which are passed to C; +if the fdopen fails, the C object is destroyed. +Otherwise, it is returned to the caller. + +C accepts one parameter or two. With one parameter, +it is just a front end for the built-in C function. With two +parameters, the first parameter is a filename that may include +whitespace or other special characters, and the second parameter is +the open mode, optionally followed by a file permission value. + +If C receives a Perl mode string (">", "+<", etc.) +or a POSIX fopen() mode string ("w", "r+", etc.), it uses the basic +Perl C operator. + +If C is given a numeric mode, it passes that mode +and the optional permissions value to the Perl C operator. +For convenience, C tries to import the O_XXX +constants from the Fcntl module. If dynamic loading is not available, +this may fail, but the rest of FileHandle will still work. + +C is like C except that its first parameter +is not a filename but rather a file handle name, a FileHandle object, +or a file descriptor number. + +If the C functions fgetpos() and fsetpos() are available, then +C returns an opaque value that represents the +current position of the FileHandle, and C uses +that value to return to a previously visited position. + +If the C function setvbuf() is available, then C +sets the buffering policy for the FileHandle. The calling sequence +for the Perl function is the same as its C counterpart, including the +macros C<_IOFBF>, C<_IOLBF>, and C<_IONBF>, except that the buffer +parameter specifies a scalar variable to use as a buffer. WARNING: A +variable used as a buffer by C must not be +modified in any way until the FileHandle is closed or until +C is called again, or memory corruption may +result! + +See L for complete descriptions of each of the following +supported C methods, which are just front ends for the +corresponding built-in functions: + + close + fileno + getc + gets + eof + clearerr + seek + tell + +See L for complete descriptions of each of the following +supported C methods: + + autoflush + output_field_separator + output_record_separator + input_record_separator + input_line_number + format_page_number + format_lines_per_page + format_lines_left + format_name + format_top_name + format_line_break_characters + format_formfeed + +Furthermore, for doing normal I/O you might need these: + +=over + +=item $fh->print + +See L. + +=item $fh->printf + +See L. + +=item $fh->getline + +This works like <$fh> described in L +except that it's more readable and can be safely called in an +array context but still returns just one line. + +=item $fh->getlines + +This works like <$fh> when called in an array context to +read all the remaining lines in a file, except that it's more readable. +It will also croak() if accidentally called in a scalar context. + +=back + +=head1 SEE ALSO + +The B extension, +L, +L. + +=cut diff --git a/lib/Net/hostent.pm b/lib/Net/hostent.pm new file mode 100644 index 0000000..1eeaae3 --- /dev/null +++ b/lib/Net/hostent.pm @@ -0,0 +1,147 @@ +package Net::hostent; +use strict; + +BEGIN { + use Exporter (); + use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + @ISA = qw(Exporter); + @EXPORT = qw(gethostbyname gethostbyaddr gethost); + @EXPORT_OK = qw( + $h_name @h_aliases + $h_addrtype $h_length + @h_addr_list $h_addr + ); + %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); +} +use vars @EXPORT_OK; + +use Class::Template qw(struct); +struct 'Net::hostent' => [ + name => '$', + aliases => '@', + addrtype => '$', + 'length' => '$', + addr_list => '@', +]; + +sub addr { shift->addr_list->[0] } + +sub populate (@) { + return unless @_; + my $hob = new(); + $h_name = $hob->[0] = $_[0]; + @h_aliases = @{ $hob->[1] } = split ' ', $_[1]; + $h_addrtype = $hob->[2] = $_[2]; + $h_length = $hob->[3] = $_[3]; + $h_addr = $_[4]; + @h_addr_list = @{ $hob->[4] } = @_[ (4 .. $#_) ]; + return $hob; +} + +sub gethostbyname ($) { populate(CORE::gethostbyname(shift)) } + +sub gethostbyaddr ($;$) { + my ($addr, $addrtype); + $addr = shift; + require Socket unless @_; + $addrtype = @_ ? shift : Socket::AF_INET(); + populate(CORE::gethostbyaddr($addr, $addrtype)) +} + +sub gethost($) { + if ($_[0] =~ /^\d+(?:\.\d+(?:\.\d+(?:\.\d+)?)?)?$/) { + require Socket; + &gethostbyaddr(Socket::inet_aton(shift)); + } else { + &gethostbyname; + } +} + +1; +__END__ + +=head1 NAME + +Net::hostent - by-name interface to Perl's built-in gethost*() functions + +=head1 SYNOPSIS + + use Net::hostnet; + +=head1 DESCRIPTION + +This module's default exports override the core gethostbyname() and +gethostbyaddr() functions, replacing them with versions that return +"Net::hostent" objects. This object has methods that return the similarly +named structure field name from the C's hostent structure from F; +namely name, aliases, addrtype, length, and addresses. The aliases and +addresses methods return array reference, the rest scalars. The addr +method is equivalent to the zeroth element in the addresses array +reference. + +You may also import all the structure fields directly into your namespace +as regular variables using the :FIELDS import tag. (Note that this still +overrides your core functions.) Access these fields as variables named +with a preceding C. Thus, C<$host_obj-Ename()> corresponds to +$h_name if you import the fields. Array references are available as +regular array variables, so for example C<@{ $host_obj-Ealiases() +}> would be simply @h_aliases. + +The gethost() funtion is a simple front-end that forwards a numeric +argument to gethostbyaddr() by way of Socket::inet_aton, and the rest +to gethostbyname(). + +To access this functionality without the core overrides, +pass the C an empty import list, and then access +function functions with their full qualified names. +On the other hand, the built-ins are still available +via the C pseudo-package. + +=head1 EXAMPLES + + use Net::hostent; + use Socket; + + @ARGV = ('netscape.com') unless @ARGV; + + for $host ( @ARGV ) { + + unless ($h = gethost($host)) { + warn "$0: no such host: $host\n"; + next; + } + + printf "\n%s is %s%s\n", + $host, + lc($h->name) eq lc($host) ? "" : "*really* ", + $h->name; + + print "\taliases are ", join(", ", @{$h->aliases}), "\n" + if @{$h->aliases}; + + if ( @{$h->addr_list} > 1 ) { + my $i; + for $addr ( @{$h->addr_list} ) { + printf "\taddr #%d is [%s]\n", $i++, inet_ntoa($addr); + } + } else { + printf "\taddress is [%s]\n", inet_ntoa($h->addr); + } + + if ($h = gethostbyaddr($h->addr)) { + if (lc($h->name) ne lc($host)) { + printf "\tThat addr reverses to host %s!\n", $h->name; + $host = $h->name; + redo; + } + } + } + +=head1 NOTE + +While this class is currently implemented using the Class::Template +module to build a struct-like class, you shouldn't rely upon this. + +=head1 AUTHOR + +Tom Christiansen diff --git a/lib/Net/netent.pm b/lib/Net/netent.pm new file mode 100644 index 0000000..9f385b0 --- /dev/null +++ b/lib/Net/netent.pm @@ -0,0 +1,165 @@ +package Net::netent; +use strict; + +BEGIN { + use Exporter (); + use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + @ISA = qw(Exporter); + @EXPORT = qw(getnetbyname getnetbyaddr getnet); + @EXPORT_OK = qw( + $n_name @n_aliases + $n_addrtype $n_net + ); + %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); +} +use vars @EXPORT_OK; + +use Class::Template qw(struct); +struct 'Net::netent' => [ + name => '$', + aliases => '@', + addrtype => '$', + net => '$', +]; + +sub populate (@) { + return unless @_; + my $nob = new(); + $n_name = $nob->[0] = $_[0]; + @n_aliases = @{ $nob->[1] } = split ' ', $_[1]; + $n_addrtype = $nob->[2] = $_[2]; + $n_net = $nob->[3] = $_[3]; + return $nob; +} + +sub getnetbyname ($) { populate(CORE::getnetbyname(shift)) } + +sub getnetbyaddr ($;$) { + my ($net, $addrtype); + $net = shift; + require Socket if @_; + $addrtype = @_ ? shift : Socket::AF_INET(); + populate(CORE::getnetbyaddr($net, $addrtype)) +} + +sub getnet($) { + if ($_[0] =~ /^\d+(?:\.\d+(?:\.\d+(?:\.\d+)?)?)?$/) { + require Socket; + &getnetbyaddr(Socket::inet_aton(shift)); + } else { + &getnetbyname; + } +} + +1; +__END__ + +=head1 NAME + +Net::netent - by-name interface to Perl's built-in getnet*() functions + +=head1 SYNOPSIS + + use Net::netent qw(:FIELDS); + getnetbyname("loopback") or die "bad net"; + printf "%s is %08X\n", $n_name, $n_net; + + use Net::netent; + + $n = getnetbyname("loopback") or die "bad net"; + { # there's gotta be a better way, eh? + @bytes = unpack("C4", pack("N", $n->net)); + shift @bytes while @bytes && $bytes[0] == 0; + } + printf "%s is %08X [%d.%d.%d.%d]\n", $n->name, $n->net, @bytes; + +=head1 DESCRIPTION + +This module's default exports override the core getnetbyname() and +getnetbyaddr() functions, replacing them with versions that return +"Net::netent" objects. This object has methods that return the similarly +named structure field name from the C's netent structure from F; +namely name, aliases, addrtype, and net. The aliases +method returns an array reference, the rest scalars. + +You may also import all the structure fields directly into your namespace +as regular variables using the :FIELDS import tag. (Note that this still +overrides your core functions.) Access these fields as variables named +with a preceding C. Thus, C<$net_obj-Ename()> corresponds to +$n_name if you import the fields. Array references are available as +regular array variables, so for example C<@{ $net_obj-Ealiases() +}> would be simply @n_aliases. + +The getnet() funtion is a simple front-end that forwards a numeric +argument to getnetbyaddr(), and the rest +to getnetbyname(). + +To access this functionality without the core overrides, +pass the C an empty import list, and then access +function functions with their full qualified names. +On the other hand, the built-ins are still available +via the C pseudo-package. + +=head1 EXAMPLES + +The getnet() functions do this in the Perl core: + + sv_setiv(sv, (I32)nent->n_net); + +The gethost() functions do this in the Perl core: + + sv_setpvn(sv, hent->h_addr, len); + +That means that the address comes back in binary for the +host functions, and as a regular perl integer for the net ones. +This seems a bug, but here's how to deal with it: + + use strict; + use Socket; + use Net::netent; + + @ARGV = ('loopback') unless @ARGV; + + my($n, $net); + + for $net ( @ARGV ) { + + unless ($n = getnetbyname($net)) { + warn "$0: no such net: $net\n"; + next; + } + + printf "\n%s is %s%s\n", + $net, + lc($n->name) eq lc($net) ? "" : "*really* ", + $n->name; + + print "\taliases are ", join(", ", @{$n->aliases}), "\n" + if @{$n->aliases}; + + # this is stupid; first, why is this not in binary? + # second, why am i going through these convolutions + # to make it looks right + { + my @a = unpack("C4", pack("N", $n->net)); + shift @a while @a && $a[0] == 0; + printf "\taddr is %s [%d.%d.%d.%d]\n", $n->net, @a; + } + + if ($n = getnetbyaddr($n->net)) { + if (lc($n->name) ne lc($net)) { + printf "\tThat addr reverses to net %s!\n", $n->name; + $net = $n->name; + redo; + } + } + } + +=head1 NOTE + +While this class is currently implemented using the Class::Template +module to build a struct-like class, you shouldn't rely upon this. + +=head1 AUTHOR + +Tom Christiansen diff --git a/lib/Net/protoent.pm b/lib/Net/protoent.pm new file mode 100644 index 0000000..ffd6acd --- /dev/null +++ b/lib/Net/protoent.pm @@ -0,0 +1,92 @@ +package Net::protoent; +use strict; + +BEGIN { + use Exporter (); + use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + @ISA = qw(Exporter); + @EXPORT = qw(getprotobyname getprotobynumber getprotoent); + @EXPORT_OK = qw( $p_name @p_aliases $p_proto ); + %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); +} +use vars @EXPORT_OK; + +use Class::Template qw(struct); +struct 'Net::protoent' => [ + name => '$', + aliases => '@', + proto => '$', +]; + +sub populate (@) { + return unless @_; + my $pob = new(); + $p_name = $pob->[0] = $_[0]; + @p_aliases = @{ $pob->[1] } = split ' ', $_[1]; + $p_proto = $pob->[2] = $_[2]; + return $pob; +} + +sub getprotoent ( ) { populate(CORE::getprotoent()) } +sub getprotobyname ($) { populate(CORE::getprotobyname(shift)) } +sub getprotobynumber ($) { populate(CORE::getprotobynumber(shift)) } + +sub getproto ($;$) { + no strict 'refs'; + return &{'getprotoby' . ($_[0]=~/^\d+$/ ? 'number' : 'name')}(@_); +} + +1; + +__END__ + +=head1 NAME + +Net::protoent - by-name interface to Perl's built-in getproto*() functions + +=head1 SYNOPSIS + + use Net::protoent; + $p = getprotobyname(shift || 'tcp') || die "no proto"; + printf "proto for %s is %d, aliases are %s\n", + $p->name, $p->proto, "@{$p->aliases}"; + + use Net::protoent qw(:FIELDS); + getprotobyname(shift || 'tcp') || die "no proto"; + print "proto for $p_name is $p_proto, aliases are @p_aliases\n"; + +=head1 DESCRIPTION + +This module's default exports override the core getprotoent(), +getprotobyname(), and getnetbyport() functions, replacing them with +versions that return "Net::protoent" objects. They take default +second arguments of "tcp". This object has methods that return the +similarly named structure field name from the C's protoent structure +from F; namely name, aliases, and proto. The aliases method +returns an array reference, the rest scalars. + +You may also import all the structure fields directly into your namespace +as regular variables using the :FIELDS import tag. (Note that this still +overrides your core functions.) Access these fields as variables named +with a preceding C. Thus, C<$proto_obj-Ename()> corresponds to +$p_name if you import the fields. Array references are available as +regular array variables, so for example C<@{ $proto_obj-Ealiases() +}> would be simply @p_aliases. + +The getproto() function is a simple front-end that forwards a numeric +argument to getprotobyport(), and the rest to getprotobyname(). + +To access this functionality without the core overrides, +pass the C an empty import list, and then access +function functions with their full qualified names. +On the other hand, the built-ins are still available +via the C pseudo-package. + +=head1 NOTE + +While this class is currently implemented using the Class::Template +module to build a struct-like class, you shouldn't rely upon this. + +=head1 AUTHOR + +Tom Christiansen diff --git a/lib/Net/servent.pm b/lib/Net/servent.pm new file mode 100644 index 0000000..8c0fc13 --- /dev/null +++ b/lib/Net/servent.pm @@ -0,0 +1,109 @@ +package Net::servent; +use strict; + +BEGIN { + use Exporter (); + use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + @ISA = qw(Exporter); + @EXPORT = qw(getservbyname getservbyport getservent getserv); + @EXPORT_OK = qw( $s_name @s_aliases $s_port $s_proto ); + %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); +} +use vars @EXPORT_OK; + +use Class::Template qw(struct); +struct 'Net::servent' => [ + name => '$', + aliases => '@', + port => '$', + proto => '$', +]; + +sub populate (@) { + return unless @_; + my $sob = new(); + $s_name = $sob->[0] = $_[0]; + @s_aliases = @{ $sob->[1] } = split ' ', $_[1]; + $s_port = $sob->[2] = $_[2]; + $s_proto = $sob->[3] = $_[3]; + return $sob; +} + +sub getservent ( ) { populate(CORE::getservent()) } +sub getservbyname ($;$) { populate(CORE::getservbyname(shift,shift||'tcp')) } +sub getservbyport ($;$) { populate(CORE::getservbyport(shift,shift||'tcp')) } + +sub getserv ($;$) { + no strict 'refs'; + return &{'getservby' . ($_[0]=~/^\d+$/ ? 'port' : 'name')}(@_); +} + +1; + +__END__ + +=head1 NAME + +Net::servent - by-name interface to Perl's built-in getserv*() functions + +=head1 SYNOPSIS + + use Net::servent; + $s = getservbyname(shift || 'ftp') || die "no service"; + printf "port for %s is %s, aliases are %s\n", + $s->name, $s->port, "@{$s->aliases}"; + + use Net::servent qw(:FIELDS); + getservbyname(shift || 'ftp') || die "no service"; + print "port for $s_name is $s_port, aliases are @s_aliases\n"; + +=head1 DESCRIPTION + +This module's default exports override the core getservent(), +getservbyname(), and +getnetbyport() functions, replacing them with versions that return +"Net::servent" objects. They take default second arguments of "tcp". This object has methods that return the similarly +named structure field name from the C's servent structure from F; +namely name, aliases, port, and proto. The aliases +method returns an array reference, the rest scalars. + +You may also import all the structure fields directly into your namespace +as regular variables using the :FIELDS import tag. (Note that this still +overrides your core functions.) Access these fields as variables named +with a preceding C. Thus, C<$serv_obj-Ename()> corresponds to +$s_name if you import the fields. Array references are available as +regular array variables, so for example C<@{ $serv_obj-Ealiases() +}> would be simply @s_aliases. + +The getserv() function is a simple front-end that forwards a numeric +argument to getservbyport(), and the rest to getservbyname(). + +To access this functionality without the core overrides, +pass the C an empty import list, and then access +function functions with their full qualified names. +On the other hand, the built-ins are still available +via the C pseudo-package. + +=head1 EXAMPLES + + use Net::servent qw(:FIELDS); + + while (@ARGV) { + my ($service, $proto) = ((split m!/!, shift), 'tcp'); + my $valet = getserv($service, $proto); + unless ($valet) { + warn "$0: No service: $service/$proto\n" + next; + } + printf "service $service/$proto is port %d\n", $valet->port; + print "alias are @s_aliases\n" if @s_aliases; + } + +=head1 NOTE + +While this class is currently implemented using the Class::Template +module to build a struct-like class, you shouldn't rely upon this. + +=head1 AUTHOR + +Tom Christiansen diff --git a/lib/Pod/Text.pm b/lib/Pod/Text.pm index 9998c48..c431728 100644 --- a/lib/Pod/Text.pm +++ b/lib/Pod/Text.pm @@ -73,8 +73,8 @@ if($termcap and !$setuptermcap) { } $SCREEN = ($_[0] =~ /^-(\d+)/ && (shift, $1)) - || ($ENV{TERMCAP} =~ /co#(\d+)/)[0] || $ENV{COLUMNS} + || ($ENV{TERMCAP} =~ /co#(\d+)/)[0] || (`stty -a 2>/dev/null` =~ /(\d+) columns/)[0] || 72; diff --git a/lib/Sys/Syslog.pm b/lib/Sys/Syslog.pm index c524170..ee901273 100644 --- a/lib/Sys/Syslog.pm +++ b/lib/Sys/Syslog.pm @@ -194,7 +194,7 @@ sub xlate { $name = uc $name; $name = "LOG_$name" unless $name =~ /^LOG_/; $name = "Sys::Syslog::$name"; - eval(&$name) || -1; + defined &$name ? &$name : -1; } sub connect { diff --git a/lib/Time/gmtime.pm b/lib/Time/gmtime.pm new file mode 100644 index 0000000..35233f5 --- /dev/null +++ b/lib/Time/gmtime.pm @@ -0,0 +1,87 @@ +package Time::gmtime; +use strict; +use Time::tm; + +BEGIN { + use Exporter (); + use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + @ISA = qw(Exporter Time::tm); + @EXPORT = qw(gmtime gmctime); + @EXPORT_OK = qw( + $tm_sec $tm_min $tm_hour $tm_mday + $tm_mon $tm_year $tm_wday $tm_yday + $tm_isdst + ); + %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); +} +use vars @EXPORT_OK; + +sub populate (@) { + return unless @_; + my $tmob = Time::tm->new(); + @$tmob = ( + $tm_sec, $tm_min, $tm_hour, $tm_mday, + $tm_mon, $tm_year, $tm_wday, $tm_yday, + $tm_isdst ) + = @_; + return $tmob; +} + +sub gmtime (;$) { populate CORE::gmtime(shift||time)} +sub gmctime (;$) { scalar CORE::gmtime(shift||time)} + +1; +__END__ + +=head1 NAME + +Time::gmtime.pm - by-name interface to Perl's built-in gmtime() function + +=head1 SYNOPSIS + + use Time::gmtime; + $gm = gmtime(); + printf "The day in Greenwich is %s\n", + (qw(Sun Mon Tue Wed Thu Fri Sat Sun))[ gm->wday() ]; + + use Time::gmtime w(:FIELDS; + printf "The day in Greenwich is %s\n", + (qw(Sun Mon Tue Wed Thu Fri Sat Sun))[ gm_wday() ]; + + $now = gmctime(); + + use Time::gmtime; + use File::stat; + $date_string = gmctime(stat($file)->mtime); + +=head1 DESCRIPTION + +This module's default exports override the core gmtime() function, +replacing it with a version that returns "Time::tm" objects. +This object has methods that return the similarly named structure field +name from the C's tm structure from F; namely sec, min, hour, +mday, mon, year, wday, yday, and isdst. + +You may also import all the structure fields directly into your namespace +as regular variables using the :FIELDS import tag. (Note that this +still overrides your core functions.) Access these fields as variables +named with a preceding C in front their method names. Thus, +C<$tm_obj-Emday()> corresponds to $tm_mday if you import the fields. + +The gmctime() funtion provides a way of getting at the +scalar sense of the original CORE::gmtime() function. + +To access this functionality without the core overrides, +pass the C an empty import list, and then access +function functions with their full qualified names. +On the other hand, the built-ins are still available +via the C pseudo-package. + +=head1 NOTE + +While this class is currently implemented using the Class::Template +module to build a struct-like class, you shouldn't rely upon this. + +=head1 AUTHOR + +Tom Christiansen diff --git a/lib/Time/localtime.pm b/lib/Time/localtime.pm new file mode 100644 index 0000000..2e811e6 --- /dev/null +++ b/lib/Time/localtime.pm @@ -0,0 +1,83 @@ +package Time::localtime; +use strict; +use Time::tm; + +BEGIN { + use Exporter (); + use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + @ISA = qw(Exporter Time::tm); + @EXPORT = qw(localtime ctime); + @EXPORT_OK = qw( + $tm_sec $tm_min $tm_hour $tm_mday + $tm_mon $tm_year $tm_wday $tm_yday + $tm_isdst + ); + %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); +} +use vars @EXPORT_OK; + +sub populate (@) { + return unless @_; + my $tmob = Time::tm->new(); + @$tmob = ( + $tm_sec, $tm_min, $tm_hour, $tm_mday, + $tm_mon, $tm_year, $tm_wday, $tm_yday, + $tm_isdst ) + = @_; + return $tmob; +} + +sub localtime (;$) { populate CORE::localtime(shift||time)} +sub ctime (;$) { scalar CORE::localtime(shift||time) } + +1; + +__END__ + +=head1 NAME + +Time::localtime.pm - by-name interface to Perl's built-in localtime() function + +=head1 SYNOPSIS + + use Time::localtime; + printf "Year is %d\n", localtime->year() + 1900; + + $now = ctime(); + + use Time::localtime; + use File::stat; + $date_string = ctime(stat($file)->mtime); + +=head1 DESCRIPTION + +This module's default exports override the core localtime() function, +replacing it with a version that returns "Time::tm" objects. +This object has methods that return the similarly named structure field +name from the C's tm structure from F; namely sec, min, hour, +mday, mon, year, wday, yday, and isdst. + +You may also import all the structure fields directly into your namespace +as regular variables using the :FIELDS import tag. (Note that this still +overrides your core functions.) Access these fields as +variables named with a preceding C in front their method names. +Thus, C<$tm_obj-Emday()> corresponds to $tm_mday if you import +the fields. + +The ctime() funtion provides a way of getting at the +scalar sense of the original CORE::localtime() function. + +To access this functionality without the core overrides, +pass the C an empty import list, and then access +function functions with their full qualified names. +On the other hand, the built-ins are still available +via the C pseudo-package. + +=head1 NOTE + +While this class is currently implemented using the Class::Template +module to build a struct-like class, you shouldn't rely upon this. + +=head1 AUTHOR + +Tom Christiansen diff --git a/lib/Time/tm.pm b/lib/Time/tm.pm new file mode 100644 index 0000000..87fc883 --- /dev/null +++ b/lib/Time/tm.pm @@ -0,0 +1,27 @@ +package Time::tm; +use strict; + +use Class::Template qw(struct); +struct('Time::tm' => [ + map { $_ => '$' } qw{ sec min hour mday mon year wday yday isdst } +]); + +1; +__END__ + +=head1 NAME + +Time::tm.pm - internal object used by Time::gmtime and Time::localtime + +=head1 DESCRIPTION + +This module is used internally as a base class by Time::localtime And +Time::gmtime functions. It creates a Time::tm struct object which is +addressable just like's C's tm structure from F; namely with sec, +min, hour, mday, mon, year, wday, yday, and isdst. + +This class is an internal interface only. + +=head1 AUTHOR + +Tom Christiansen diff --git a/lib/User/grent.pm b/lib/User/grent.pm new file mode 100644 index 0000000..1185958 --- /dev/null +++ b/lib/User/grent.pm @@ -0,0 +1,91 @@ +package User::grent; +use strict; + +BEGIN { + use Exporter (); + use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + @ISA = qw(Exporter); + @EXPORT = qw(getgrent getgrgid getgrnam getgr); + @EXPORT_OK = qw($gr_name $gr_gid $gr_passwd $gr_mem @gr_members); + %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); +} +use vars @EXPORT_OK; + +use Class::Template qw(struct); +struct 'User::grent' => [ + name => '$', + passwd => '$', + gid => '$', + members => '@', +]; + +sub populate (@) { + return unless @_; + my $gob = new(); + ($gr_name, $gr_passwd, $gr_gid) = @$gob[0,1,2] = @_[0,1,2]; + @gr_members = @{$gob->[3]} = split ' ', $_[3]; + return $gob; +} + +sub getgrent ( ) { populate(CORE::getgrent()) } +sub getgrnam ($) { populate(CORE::getgrnam(shift)) } +sub getgrgid ($) { populate(CORE::getgrgid(shift)) } +sub getgr ($) { ($_[0] =~ /^\d+/) ? &getgrgid : &getgrnam } + +1; +__END__ + +=head1 NAME + +User::grent.pm - by-name interface to Perl's built-in getgr*() functions + +=head1 SYNOPSIS + + use User::grent; + $gr = getgrgid(0) or die "No group zero"; + if ( $gr->name eq 'wheel' && @{$gr->members} > 1 ) { + print "gid zero name wheel, with other members"; + } + + use User::grent qw(:FIELDS; + getgrgid(0) or die "No group zero"; + if ( $gr_name eq 'wheel' && @gr_members > 1 ) { + print "gid zero name wheel, with other members"; + } + + $gr = getgr($whoever); + +=head1 DESCRIPTION + +This module's default exports override the core getgrent(), getgruid(), +and getgrnam() functions, replacing them with versions that return +"User::grent" objects. This object has methods that return the similarly +named structure field name from the C's passwd structure from F; +namely name, passwd, gid, and members (not mem). The first three +return scalars, the last an array reference. + +You may also import all the structure fields directly into your namespace +as regular variables using the :FIELDS import tag. (Note that this still +overrides your core functions.) Access these fields as variables named +with a preceding C. Thus, C<$group_obj-Egid()> corresponds +to $gr_gid if you import the fields. Array references are available as +regular array variables, so C<@{ $group_obj-Emembers() }> would be +simply @gr_members. + +The getpw() funtion is a simple front-end that forwards +a numeric argument to getpwuid() and the rest to getpwnam(). + +To access this functionality without the core overrides, +pass the C an empty import list, and then access +function functions with their full qualified names. +On the other hand, the built-ins are still available +via the C pseudo-package. + +=head1 NOTE + +While this class is currently implemented using the Class::Template +module to build a struct-like class, you shouldn't rely upon this. + +=head1 AUTHOR + +Tom Christiansen diff --git a/lib/User/pwent.pm b/lib/User/pwent.pm new file mode 100644 index 0000000..fd4eb4f --- /dev/null +++ b/lib/User/pwent.pm @@ -0,0 +1,101 @@ +package User::pwent; +use strict; + +BEGIN { + use Exporter (); + use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + @ISA = qw(Exporter); + @EXPORT = qw(getpwent getpwuid getpwnam getpw); + @EXPORT_OK = qw( + $pw_name $pw_passwd $pw_uid + $pw_gid $pw_quota $pw_comment + $pw_gecos $pw_dir $pw_shell + ); + %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); +} +use vars @EXPORT_OK; + +use Class::Template qw(struct); +struct 'User::pwent' => [ + name => '$', + passwd => '$', + uid => '$', + gid => '$', + quota => '$', + comment => '$', + gcos => '$', + dir => '$', + shell => '$', +]; + +sub populate (@) { + return unless @_; + my $pwob = new(); + + ( $pw_name, $pw_passwd, $pw_uid, + $pw_gid, $pw_quota, $pw_comment, + $pw_gecos, $pw_dir, $pw_shell, ) = @$pwob = @_; + + return $pwob; +} + +sub getpwent ( ) { populate(CORE::getpwent()) } +sub getpwnam ($) { populate(CORE::getpwnam(shift)) } +sub getpwgid ($) { populate(CORE::getpwgid(shift)) } +sub getpw ($) { ($_[0] =~ /^\d+/) ? &getpwgid : &getpwnam } + +1; +__END__ + +=head1 NAME + +User::pwent.pm - by-name interface to Perl's built-in getpw*() functions + +=head1 SYNOPSIS + + use User::pwent; + $pw = getpwnam('daemon') or die "No daemon user"; + if ( $pw->uid == 1 && $pw->dir =~ m#^/(bin|tmp)?$# ) { + print "gid 1 on root dir"; + } + + use User::pwent qw(:FIELDS); + getpwnam('daemon') or die "No daemon user"; + if ( $pw_uid == 1 && $pw_dir =~ m#^/(bin|tmp)?$# ) { + print "gid 1 on root dir"; + } + + $pw = getpw($whoever); + +=head1 DESCRIPTION + +This module's default exports override the core getpwent(), getpwuid(), +and getpwnam() functions, replacing them with versions that return +"User::pwent" objects. This object has methods that return the similarly +named structure field name from the C's passwd structure from F; +namely name, passwd, uid, gid, quota, comment, gecos, dir, and shell. + +You may also import all the structure fields directly into your namespace +as regular variables using the :FIELDS import tag. (Note that this still +overrides your core functions.) Access these fields as +variables named with a preceding C in front their method names. +Thus, C<$passwd_obj-Eshell()> corresponds to $pw_shell if you import +the fields. + +The getpw() funtion is a simple front-end that forwards +a numeric argument to getpwuid() and the rest to getpwnam(). + +To access this functionality without the core overrides, +pass the C an empty import list, and then access +function functions with their full qualified names. +On the other hand, the built-ins are still available +via the C pseudo-package. + +=head1 NOTE + +While this class is currently implemented using the Class::Template +module to build a struct-like class, you shouldn't rely upon this. + +=head1 AUTHOR + +Tom Christiansen diff --git a/lib/perl5db.pl b/lib/perl5db.pl index 7f3756f..fcc30c6 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -17,8 +17,8 @@ $header = "perl5db.pl patch level $VERSION"; # This file is automatically included if you do perl -d. # It's probably not useful to include this yourself. # -# Perl supplies the values for @line and %sub. It effectively inserts -# a &DB'DB(); in front of every place that can have a +# Perl supplies the values for %sub. It effectively inserts +# a &DB'DB(); in front of every place that can have a # breakpoint. Instead of a subroutine call it calls &DB::sub with # $DB::sub being the called subroutine. It also inserts a BEGIN # {require 'perl5db.pl'} before the first line. @@ -45,7 +45,7 @@ $header = "perl5db.pl patch level $VERSION"; # The scalar ${"_<$filename"} contains "_<$filename". # # Note that no subroutine call is possible until &DB::sub is defined -# (for subroutines defined outside this file). In fact the same is +# (for subroutines defined outside of the package DB). In fact the same is # true if $deep is not defined. # # $Log: perldb.pl,v $ @@ -120,6 +120,9 @@ $header = "perl5db.pl patch level $VERSION"; # When restarting debugger breakpoints/actions persist. # Buglet: When restarting debugger only one breakpoint/action per # autoloaded function persists. +# Changes: 0.97: NonStop will not stop in at_exit(). +# Option AutoTrace implemented. +# Trace printed differently if frames are printed too. #################################################################### @@ -140,7 +143,7 @@ warn ( # Do not ;-) @ARGS, $Carp::CarpLevel, $panic, - $first_time, + $second_time, ) if 0; # Command-line + PERLLIB: @@ -154,10 +157,10 @@ $inhibit_exit = $option{PrintRet} = 1; @options = qw(hashDepth arrayDepth DumpDBFiles DumpPackages compactDump veryCompact quote HighBit undefPrint - globPrint PrintRet UsageOnly frame + globPrint PrintRet UsageOnly frame AutoTrace TTY noTTY ReadLine NonStop LineInfo recallCommand ShellBang pager tkRunning - signalLevel warnLevel dieLevel); + signalLevel warnLevel dieLevel inhibit_exit); %optionVars = ( hashDepth => \$dumpvar::hashDepth, @@ -169,7 +172,9 @@ $inhibit_exit = $option{PrintRet} = 1; globPrint => \$dumpvar::globPrint, tkRunning => \$readline::Tk_toloop, UsageOnly => \$dumpvar::usageOnly, - frame => \$frame, + frame => \$frame, + AutoTrace => \$trace, + inhibit_exit => \$inhibit_exit, ); %optionAction = ( @@ -317,15 +322,17 @@ if (defined &afterinit) { # May be defined in $rcfile ############################################################ Subroutines sub DB { - unless ($first_time++) { # Do when-running init - if ($runnonstop) { # Disable until signal + # _After_ the perl program is compiled, $single is set to 1: + if ($single and not $second_time++) { + if ($runnonstop) { # Disable until signal for ($i=0; $i <= $#stack; ) { $stack[$i++] &= ~1; } $single = 0; - return; + # return; # Would not print trace! } } + $runnonstop = 0 if $single or $signal; # Disable it if interactive. &save; ($package, $filename, $line) = caller; $filename_ini = $filename; @@ -341,7 +348,9 @@ sub DB { $dbline{$line} =~ s/;9($|\0)/$1/; } } - if ($single || $trace || $signal) { + my $was_signal = $signal; + $signal = 0; + if ($single || $trace || $was_signal) { $term || &setterm; if ($emacs) { $position = "\032\032$filename:$line:0\n"; @@ -353,25 +362,33 @@ sub DB { $after = ($dbline[$line] =~ /\n$/ ? '' : "\n"); if (length($prefix) > 30) { $position = "$prefix$line):\n$line:\t$dbline[$line]$after"; - print $LINEINFO $position; $prefix = ""; $infix = ":\t"; } else { $infix = "):\t"; $position = "$prefix$line$infix$dbline[$line]$after"; + } + if ($frame) { + print $LINEINFO ' ' x $#stack, "$line:\t$dbline[$line]$after"; + } else { print $LINEINFO $position; } for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) { #{ vi last if $dbline[$i] =~ /^\s*[\;\}\#\n]/; + last if $signal; $after = ($dbline[$i] =~ /\n$/ ? '' : "\n"); $incr_pos = "$prefix$i$infix$dbline[$i]$after"; - print $LINEINFO $incr_pos; $position .= $incr_pos; + if ($frame) { + print $LINEINFO ' ' x $#stack, "$i:\t$dbline[$i]$after"; + } else { + print $LINEINFO $incr_pos; + } } } } $evalarg = $action, &eval if $action; - if ($single || $signal) { + if ($single || $was_signal) { local $level = $level + 1; map {$evalarg = $_, &eval} @$pre; print $OUT $#stack . " levels deep in subroutine calls!\n" @@ -528,7 +545,7 @@ sub DB { $arrow = ($i==$line and $filename eq $filename_ini) ? '==>' - : ':' ; + : ($dbline[$i]+0 ? ':' : ' ') ; $arrow .= 'b' if $stop; $arrow .= 'a' if $action; print $OUT "$i$arrow\t", $dbline[$i]; @@ -848,7 +865,7 @@ sub DB { print $OUT "exec failed: $!\n"; last CMD; }; $cmd =~ /^T$/ && do { - print_trace($OUT, 3); # skip DB print_trace dump_trace + print_trace($OUT, 1); # skip DB next CMD; }; $cmd =~ /^\/(.*)$/ && do { $inpat = $1; @@ -1030,7 +1047,11 @@ sub sub { if ($sub =~ /::AUTOLOAD$/) { $al = " for $ {$` . '::AUTOLOAD'}"; } - print $LINEINFO ' ' x $#stack, "entering $sub$al\n" if $frame; + ($frame & 4 + ? ( (print $LINEINFO ' ' x $#stack, "in "), + # Why -1? But it works! :-( + print_trace($LINEINFO, -1, 1, 1, "$sub$al") ) + : print $LINEINFO ' ' x $#stack, "entering $sub$al\n") if $frame; push(@stack, $single); $single &= 1; $single |= 4 if $#stack == $deep; @@ -1039,14 +1060,20 @@ sub sub { $single |= pop(@stack); print ($OUT "list context return from $sub:\n"), dumpit( \@ret ), $doret = -2 if $doret eq $#stack; - print $LINEINFO ' ' x $#stack, "exited $sub$al\n" if $frame > 1; + ($frame & 4 + ? ( (print $LINEINFO ' ' x $#stack, "out "), + print_trace($LINEINFO, -1, 1, 1, "$sub$al") ) + : print $LINEINFO ' ' x $#stack, "exited $sub$al\n") if $frame & 2; @ret; } else { $ret = &$sub; $single |= pop(@stack); print ($OUT "scalar context return from $sub: "), dumpit( $ret ), $doret = -2 if $doret eq $#stack; - print $LINEINFO ' ' x $#stack, "exited $sub$al\n" if $frame > 1; + ($frame & 4 + ? ( (print $LINEINFO ' ' x $#stack, "out "), + print_trace($LINEINFO, -1, 1, 1, "$sub$al") ) + : print $LINEINFO ' ' x $#stack, "exited $sub$al\n") if $frame & 2; $ret; } } @@ -1071,6 +1098,7 @@ sub eval { $^D = $od; } my $at = $@; + local $saved[0]; # Preserve the old value of $@ eval "&DB::save"; if ($at) { print $OUT $at; @@ -1098,7 +1126,7 @@ sub postponed_sub { } return; } - print $OUT "In postponed_sub for `$subname'.\n"; + #print $OUT "In postponed_sub for `$subname'.\n"; } sub postponed { @@ -1108,7 +1136,9 @@ sub postponed { local *dbline = shift; my $filename = $dbline; $filename =~ s/^_= 4 ? $_[3] : $sub[$i]{sub}; + print $fh "$sub[$i]{context}=$sub$args from $file:$sub[$i]{line}\n"; + } else { + print $fh "$sub[$i]{context} = $sub[$i]{sub}$args" . + " called from $file" . + " line $sub[$i]{line}\n"; + } } } sub dump_trace { my $skip = shift; + my $count = shift || 1e9; + $skip++; + $count += $skip; my ($p,$file,$line,$sub,$h,$args,$e,$r,@a,@sub,$context); for ($i = $skip; - ($p,$file,$line,$sub,$h,$context,$e,$r) = caller($i); + $i < $count and ($p,$file,$line,$sub,$h,$context,$e,$r) = caller($i); $i++) { @a = (); for $arg (@args) { @@ -1172,7 +1213,7 @@ sub dump_trace { s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg; push(@a, $_); } - $context = $context ? '@ = ' : '$ = '; + $context = $context ? '@' : '$'; $args = $h ? [@a] : undef; $e =~ s/\n\s*\;\s*\Z// if $e; $e =~ s/[\\\']/\\$1/g if $e; @@ -1514,7 +1555,7 @@ w [line] List window around line. f filename Switch to viewing filename. /pattern/ Search forwards for pattern; final / is optional. ?pattern? Search backwards for pattern; final ? is optional. -L List all breakpoints and actions for the current file. +L List all breakpoints and actions. S [[!]pattern] List subroutine names [not] matching pattern. t Toggle trace mode. t expr Trace through execution of expr. @@ -1543,6 +1584,9 @@ O [opt[=val]] [opt\"val\"] [opt?]... be abbreviated. Several options can be listed. recallCommand, ShellBang: chars used to recall command or spawn shell; pager: program for output of \"|cmd\"; + tkRunning: run Tk while prompting (with ReadLine); + signalLevel warnLevel dieLevel: level of verbosity; + inhibit_exit Allows stepping off the end of the script. The following options affect what happens with V, X, and x commands: arrayDepth, hashDepth: print only first N elements ('' for all); compactDump, veryCompact: change style of array and hash dump; @@ -1550,10 +1594,9 @@ O [opt[=val]] [opt\"val\"] [opt?]... DumpDBFiles: dump arrays holding debugged files; DumpPackages: dump symbol tables of packages; quote, HighBit, undefPrint: change style of string dump; - tkRunning: run Tk while prompting (with ReadLine); - signalLevel warnLevel dieLevel: level of verbosity; Option PrintRet affects printing of return value after r command, frame affects printing messages on entry and exit from subroutines. + AutoTrace affects printing messages on every possible breaking point. During startup options are initialized from \$ENV{PERLDB_OPTS}. You can put additional initialization options TTY, noTTY, ReadLine, and NonStop there. @@ -1580,6 +1623,9 @@ command Execute as a perl statement in current package. v Show versions of loaded modules. R Pure-man-restart of debugger, some of debugger state and command-line options may be lost. + Currently the following setting are preserved: + history, breakpoints and actions, debugger Options + and the following command-line options: -w, -I, -e. h [db_command] Get help [on a specific debugger command], enter |h to page. h h Summary of debugger commands. q or ^D Quit. Set \$DB::finished to 0 to debug global destruction. @@ -1818,8 +1864,9 @@ sub end_report { print $OUT "Use `q' to quit and `R' to restart. `h q' for detai END { $finished = $inhibit_exit; # So that some keys may be disabled. - $DB::single = !$exiting; # Do not trace destructors on exit - DB::fake::at_exit() unless $exiting; + # Do not stop in at_exit() and destructors on exit: + $DB::single = !$exiting && !$runnonstop; + DB::fake::at_exit() unless $exiting or $runnonstop; } package DB::fake; @@ -1828,4 +1875,6 @@ sub at_exit { "Debuggee terminated. Use `q' to quit and `R' to restart."; } +package DB; # Do not trace this 1; below! + 1; diff --git a/lib/sigtrap.pm b/lib/sigtrap.pm index ed5925b..c081123 100644 --- a/lib/sigtrap.pm +++ b/lib/sigtrap.pm @@ -167,9 +167,9 @@ installed signals. =item B -The handler used for subsequently installed signals will output a Perl -stack trace to STDERR and then tries to dump core. This is the default -signal handler. +The handler used for subsequently installed signals outputs a Perl stack +trace to STDERR and then tries to dump core. This is the default signal +handler. =item B @@ -186,7 +186,7 @@ assignment to an element of C<%SIG>. =head2 SIGNAL LISTS -B has two built-in lists of signals to trap. They are: +B has a few built-in lists of signals to trap. They are: =over 4 @@ -222,7 +222,7 @@ silently ignored. =item B -This token tells B only to install handlers for subsequently +This token tells B to install handlers only for subsequently listed signals which aren't already trapped or ignored. =item B @@ -232,9 +232,9 @@ listed signals. This is the default behavior. =item I -Any argument which looks like a signals name (that is, -C) is taken as a signal name and indicates that -B should install a handler for it. +Any argument which looks like a signal name (that is, +C) indicates that B should install a +handler for that name. =item I diff --git a/lib/syslog.pl b/lib/syslog.pl index 8807ef0..9e03399 100644 --- a/lib/syslog.pl +++ b/lib/syslog.pl @@ -143,7 +143,7 @@ sub xlate { $name = uc $name; $name = "LOG_$name" unless $name =~ /^LOG_/; $name = "syslog'$name"; - eval(&$name) || -1; + defined &$name ? &$name : -1; } sub connect { diff --git a/old_embed.pl b/old_embed.pl index eb3d306..9453feb 100755 --- a/old_embed.pl +++ b/old_embed.pl @@ -7,6 +7,7 @@ # Perl with the EMBED feature enabled. # +unlink "embed.h"; open(EM, ">embed.h") || die "Can't create embed.h: $!\n"; print EM <<'END'; diff --git a/old_perl_exp.SH b/old_perl_exp.SH index 637901b..123ae0c 100755 --- a/old_perl_exp.SH +++ b/old_perl_exp.SH @@ -32,8 +32,8 @@ perl_init_i18nl14n perl_new_collate perl_new_ctype perl_new_numeric -perl_numeric_local -perl_numeric_standard +perl_set_numeric_local +perl_set_numeric_standard perl_alloc perl_construct perl_destruct diff --git a/op.c b/op.c index 8527ccc..639454d 100644 --- a/op.c +++ b/op.c @@ -550,7 +550,8 @@ OP *op; OP *kid; /* assumes no premature commitment */ - if (!op || (op->op_flags & OPf_KNOW) || error_count) + if (!op || (op->op_flags & OPf_KNOW) || op->op_type == OP_RETURN + || error_count) return op; op->op_flags &= ~OPf_LIST; @@ -621,6 +622,8 @@ OP *op; default: if (!(opargs[op->op_type] & OA_FOLDCONST)) break; + /* FALL THROUGH */ + case OP_REPEAT: if (op->op_flags & OPf_STACKED) break; /* FALL THROUGH */ @@ -739,11 +742,6 @@ OP *op; op->op_ppaddr = ppaddr[OP_PREDEC]; break; - case OP_REPEAT: - scalarvoid(cBINOP->op_first); - useless = op_desc[op->op_type]; - break; - case OP_OR: case OP_AND: case OP_COND_EXPR: @@ -804,7 +802,8 @@ OP *op; OP *kid; /* assumes no premature commitment */ - if (!op || (op->op_flags & OPf_KNOW) || error_count) + if (!op || (op->op_flags & OPf_KNOW) || op->op_type == OP_RETURN + || error_count) return op; op->op_flags |= (OPf_KNOW | OPf_LIST); @@ -1305,15 +1304,12 @@ int full; } OP* -block_end(line, floor, seq) -int line; -int floor; +block_end(floor, seq) +I32 floor; OP* seq; { int needblockscope = hints & HINT_BLOCK_SCOPE; OP* retval = scalarseq(seq); - if (copline > (line_t)line) - copline = line; LEAVE_SCOPE(floor); pad_reset_pending = FALSE; if (needblockscope) @@ -1837,6 +1833,9 @@ I32 flags; pmop->op_flags = flags; pmop->op_private = 0 | (flags >> 8); + if (hints & HINT_LOCALE) + pmop->op_pmpermflags = (pmop->op_pmflags |= PMf_LOCALE); + /* link into pm list */ if (type != OP_TRANS && curstash) { pmop->op_pmnext = HvPMROOT(curstash); @@ -3786,7 +3785,7 @@ OP *op; op = listkids(op); op->op_private = 0; -#ifdef HAS_SETLOCALE +#ifdef USE_LOCALE if (hints & HINT_LOCALE) op->op_private |= OPpLOCALE; #endif @@ -3801,7 +3800,7 @@ OP *op; op = ck_fun(op); op->op_private = 0; -#ifdef HAS_SETLOCALE +#ifdef USE_LOCALE if (hints & HINT_LOCALE) op->op_private |= OPpLOCALE; #endif @@ -3814,10 +3813,11 @@ ck_scmp(op) OP *op; { op->op_private = 0; -#ifdef LC_COLLATE +#ifdef USE_LOCALE if (hints & HINT_LOCALE) op->op_private |= OPpLOCALE; #endif + return op; } @@ -3924,7 +3924,7 @@ ck_sort(op) OP *op; { op->op_private = 0; -#ifdef LC_COLLATE +#ifdef USE_LOCALE if (hints & HINT_LOCALE) op->op_private |= OPpLOCALE; #endif diff --git a/opcode.h b/opcode.h index 97b3034..f0b18d0 100644 --- a/opcode.h +++ b/opcode.h @@ -1867,8 +1867,8 @@ EXT OP * (*check[]) _((OP *op)) = { ck_scmp, /* sgt */ ck_scmp, /* sle */ ck_scmp, /* sge */ - ck_scmp, /* seq */ - ck_scmp, /* sne */ + ck_null, /* seq */ + ck_null, /* sne */ ck_scmp, /* scmp */ ck_bitop, /* bit_and */ ck_bitop, /* bit_xor */ diff --git a/opcode.pl b/opcode.pl index d679d8a..3b3672d 100755 --- a/opcode.pl +++ b/opcode.pl @@ -1,5 +1,6 @@ #!/usr/bin/perl +unlink "opcode.h"; open(OC, ">opcode.h") || die "Can't create opcode.h: $!\n"; select OC; @@ -300,8 +301,8 @@ slt string lt ck_scmp ifs S S sgt string gt ck_scmp ifs S S sle string le ck_scmp ifs S S sge string ge ck_scmp ifs S S -seq string eq ck_scmp ifs S S -sne string ne ck_scmp ifs S S +seq string eq ck_null ifs S S +sne string ne ck_null ifs S S scmp string comparison ck_scmp ifst S S bit_and bitwise and ck_bitop fst S S diff --git a/patchlevel.h b/patchlevel.h index a2abcc1..a047efb 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1,5 +1,5 @@ #define PATCHLEVEL 3 -#define SUBVERSION 10 +#define SUBVERSION 11 /* local_patches -- list of locally applied less-than-subversion patches. diff --git a/perl.c b/perl.c index 4777070..2544fd3 100644 --- a/perl.c +++ b/perl.c @@ -121,7 +121,7 @@ register PerlInterpreter *sv_interp; init_ids(); - NUMERIC_STANDARD(); + SET_NUMERIC_STANDARD(); #if defined(SUBVERSION) && SUBVERSION > 0 sprintf(patchlevel, "%7.5f", (double) 5 + ((double) PATCHLEVEL / (double) 1000) @@ -826,8 +826,12 @@ I32 flags; /* See G_* flags in cop.h */ if (flags & G_ARRAY) myop.op_flags |= OPf_LIST; - if (perldb && curstash != debstash - && (DBcv || (DBcv = GvCV(DBsub)))) /* to handle first BEGIN of -d */ + if (perldb && curstash != debstash + /* Handle first BEGIN of -d. */ + && (DBcv || (DBcv = GvCV(DBsub))) + /* Try harder, since this may have been a sighandler, thus + * curstash may be meaningless. */ + && (SvTYPE(sv) != SVt_PVCV || CvSTASH((CV*)sv) != debstash)) op->op_private |= OPpENTERSUB_DB; if (flags & G_EVAL) { diff --git a/perl.h b/perl.h index 16c119e..17402a4 100644 --- a/perl.h +++ b/perl.h @@ -20,8 +20,6 @@ #undef NO_EMBED #define NO_EMBED #undef MULTIPLICITY -#undef HIDEMYMALLOC -#undef EMBEDMYMALLOC #undef USE_STDIO #define USE_STDIO #endif /* PERL_FOR_X2P */ @@ -190,14 +188,28 @@ #include #endif /* USE_NEXT_CTYPE */ -#ifdef I_LOCALE -#include -#endif - #ifdef METHOD /* Defined by OSF/1 v3.0 by ctype.h */ #undef METHOD #endif +#ifdef I_LOCALE +# include +#endif + +#if !defined(NO_LOCALE) && defined(HAS_SETLOCALE) +# define USE_LOCALE +# if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \ + && defined(HAS_STRXFRM) +# define USE_LOCALE_COLLATE +# endif +# if !defined(NO_LOCALE_CTYPE) && defined(LC_CTYPE) +# define USE_LOCALE_CTYPE +# endif +# if !defined(NO_LOCALE_NUMERIC) && defined(LC_NUMERIC) +# define USE_LOCALE_NUMERIC +# endif +#endif /* !NO_LOCALE && HAS_SETLOCALE */ + #include #ifdef I_SYS_PARAM @@ -262,10 +274,6 @@ #define strrchr rindex #endif -#if defined(mips) && defined(ultrix) && !defined(__STDC__) -# undef HAS_MEMCMP -#endif - #ifdef I_MEMORY # include #endif @@ -303,18 +311,6 @@ # endif #endif /* HAS_MEMSET */ -#ifdef HAS_MEMCMP -# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) -# ifndef memcmp - extern int memcmp _((char*, char*, int)); -# endif -# endif -#else -# ifndef memcmp -# define memcmp my_memcmp -# endif -#endif /* HAS_MEMCMP */ - #if !defined(HAS_MEMMOVE) && !defined(memmove) # if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY) # define memmove(d,s,l) bcopy(s,d,l) @@ -327,6 +323,31 @@ # endif #endif +#if defined(mips) && defined(ultrix) && !defined(__STDC__) +# undef HAS_MEMCMP +#endif + +#if defined(HAS_MEMCMP) && defined(HAS_SANE_MEMCMP) +# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) +# ifndef memcmp + extern int memcmp _((char*, char*, int)); +# endif +# endif +# ifdef BUGGY_MSC + # pragma function(memcmp) +# endif +#else +# ifndef memcmp +# define memcmp my_memcmp +# endif +#endif /* HAS_MEMCMP && HAS_SANE_MEMCMP */ + +#ifndef HAS_BCMP +# ifndef bcmp +# define bcmp(s1,s2,l) memcmp(s1,s2,l) +# endif +#endif /* !HAS_BCMP */ + #ifdef I_NETINET_IN # include #endif @@ -1342,7 +1363,7 @@ EXT SV * psig_name[]; /* fast case folding tables */ #ifdef DOINIT -EXT const unsigned char fold[] = { +EXTCONST unsigned char fold[] = { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, @@ -1876,7 +1897,7 @@ EXT MGVTBL vtbl_uvar = {magic_getuvar, magic_setuvar, 0, 0, 0}; -#ifdef LC_COLLATE +#ifdef USE_LOCALE_COLLATE EXT MGVTBL vtbl_collxfrm = {0, magic_setcollxfrm, 0, 0, 0}; @@ -1913,7 +1934,7 @@ EXT MGVTBL vtbl_bm; EXT MGVTBL vtbl_fm; EXT MGVTBL vtbl_uvar; -#ifdef HAS_STRXFRM +#ifdef USE_LOCALE_COLLATE EXT MGVTBL vtbl_collxfrm; #endif @@ -2008,32 +2029,39 @@ enum { copy_amg, neg_amg }; #endif /* OVERLOAD */ - -#ifdef LC_COLLATE + +#ifdef USE_LOCALE_COLLATE EXT U32 collation_ix; /* Collation generation index */ EXT char * collation_name; /* Name of current collation */ EXT bool collation_standard INIT(TRUE); /* Assume simple collation */ EXT Size_t collxfrm_base; /* Basic overhead in *xfrm() */ EXT Size_t collxfrm_mult INIT(2); /* Expansion factor in *xfrm() */ -#endif /* LC_COLLATE */ +#endif /* USE_LOCALE_COLLATE */ -#ifdef LC_NUMERIC +#ifdef USE_LOCALE_NUMERIC EXT char * numeric_name; /* Name of current numeric locale */ EXT bool numeric_standard INIT(TRUE); /* Assume simple numerics */ EXT bool numeric_local INIT(TRUE); /* Assume local numerics */ -#define NUMERIC_STANDARD() \ - STMT_START { if (! numeric_standard) perl_numeric_standard(); } STMT_END -#define NUMERIC_LOCAL() \ - STMT_START { if (! numeric_local) perl_numeric_local(); } STMT_END +#define SET_NUMERIC_STANDARD() \ + STMT_START { \ + if (! numeric_standard) \ + perl_set_numeric_standard(); \ + } STMT_END + +#define SET_NUMERIC_LOCAL() \ + STMT_START { \ + if (! numeric_local) \ + perl_set_numeric_local(); \ + } STMT_END -#else /* !LC_NUMERIC */ +#else /* !USE_LOCALE_NUMERIC */ -#define NUMERIC_STANDARD() /**/ -#define NUMERIC_LOCAL() /**/ +#define SET_NUMERIC_STANDARD() /**/ +#define SET_NUMERIC_LOCAL() /**/ -#endif /* !LC_NUMERIC */ +#endif /* !USE_LOCALE_NUMERIC */ #if !defined(PERLIO_IS_STDIO) && defined(HAS_ATTRIBUTE) /* diff --git a/perl_exp.SH b/perl_exp.SH index 1753863..cef4d64 100755 --- a/perl_exp.SH +++ b/perl_exp.SH @@ -35,8 +35,8 @@ perl_init_i18nl14n perl_new_collate perl_new_ctype perl_new_numeric -perl_numeric_local -perl_numeric_standard +perl_set_numeric_local +perl_set_numeric_standard perl_alloc perl_construct perl_destruct diff --git a/perly.c b/perly.c index 280069f..3bcc237 100644 --- a/perly.c +++ b/perly.c @@ -12,6 +12,7 @@ dep() deprecate("\"do\" to call subroutines"); } +#line 16 "perly.c" #define YYERRCODE 256 short yylhs[] = { -1, 40, 0, 7, 5, 8, 6, 9, 9, 9, 10, @@ -56,15 +57,15 @@ short yydefred[] = { 1, 9, 11, 0, 50, 51, 52, 0, 0, 0, 61, 0, 14, 4, 151, 0, 0, 126, 0, 146, 0, 59, 59, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 158, 159, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 158, 159, 0, 0, 0, 0, 0, 0, 0, 0, 12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 10, 0, 0, 0, 0, 116, 118, 0, 0, 0, 0, 152, 0, 54, 0, 60, 0, 7, 167, 170, 169, 168, 0, 0, 0, 0, 0, 0, 4, 0, 4, 0, 4, 0, 4, 0, 4, 4, 0, 0, 0, 0, 0, - 165, 0, 132, 0, 0, 0, 0, 0, 161, 0, - 0, 0, 0, 74, 0, 141, 0, 0, 0, 0, + 141, 0, 0, 0, 0, 74, 0, 165, 0, 132, + 0, 0, 0, 0, 0, 161, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 106, 0, 162, 163, 164, 166, 0, 0, 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -72,8 +73,8 @@ short yydefred[] = { 1, 0, 0, 0, 0, 0, 0, 13, 0, 53, 58, 0, 0, 0, 72, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 145, - 147, 0, 0, 0, 0, 0, 0, 108, 0, 130, - 0, 0, 0, 105, 28, 0, 0, 19, 0, 0, + 147, 0, 0, 0, 0, 0, 0, 0, 108, 0, + 130, 0, 0, 105, 28, 0, 0, 19, 0, 0, 0, 63, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 77, 0, 78, 0, 0, 0, 0, 0, 0, 0, 128, 0, @@ -94,619 +95,609 @@ short yydgoto[] = { 1, 9, 66, 10, 17, 85, 337, 88, 313, 3, 11, 12, 68, 272, 268, 70, 71, 72, 73, 74, 75, 76, 278, 78, 279, 262, 265, 269, 281, 263, 266, - 124, 204, 90, 79, 242, 181, 145, 276, 13, 2, + 116, 204, 90, 79, 242, 181, 145, 276, 13, 2, 14, 15, 16, }; short yysindex[] = { 0, - 0, 0, -118, 0, 0, 0, -52, 0, 0, 0, - 0, 0, 616, 0, 0, 0, -117, -225, -12, 0, - -219, 0, 0, 0, -28, -28, 0, 32, 0, 2245, - 0, 0, -7, -6, 3, 22, -35, 2245, 38, 44, - 48, -28, 1004, 1067, -196, 0, 0, -28, 2245, 948, - 1343, 2245, 2245, 2245, 2245, 2245, 1399, 0, 2245, 2245, - 1455, -28, -28, -28, -28, 2245, -215, 0, 192, 3934, - -67, -50, 0, 0, -10, 71, 64, 81, 0, 4, - 0, -114, 0, -115, 0, 0, 0, 0, 0, 2245, - 115, 2245, 3934, 4, -114, 0, 4, 0, 4, 0, - 4, 0, 4, 0, 0, 125, 3934, 126, 1518, 948, - 0, 130, 0, 2305, -24, 46, -56, 2245, 0, 81, - 0, -67, 81, 0, 2245, 0, 2305, -77, -77, -77, - -81, -81, 83, -21, -77, -77, 0, -84, 0, 0, - 0, 0, 2305, 4, 0, 2245, 2245, 2245, 2245, 2245, - 2245, 2245, 2245, 2245, 2245, 2245, 2245, 2245, 2245, 2245, - 2245, 2245, 2245, 2245, 2245, 2245, 0, 0, -17, 2245, - 2245, 2245, 2245, 2245, 2245, 1794, 0, 2245, 0, 0, - -36, 2245, -49, 0, 2245, 326, 2245, 4, 2245, -215, - 2245, -215, 2245, -156, 2245, -156, 143, 1850, 0, 0, - 0, -2, 13, 140, 2245, 1906, 1969, 0, 58, 0, - 81, 2245, 95, 0, 0, -164, -164, 0, -164, -164, - -109, 0, -48, 2384, 2305, 2819, 941, 1031, 3934, 3894, - 3965, 3724, 359, 435, 1190, -77, -77, 2245, 0, 2245, - 0, 149, -80, 21, -65, 23, 82, 56, 0, 8, - 3934, 0, 0, 136, 0, 155, 0, 2245, 0, 0, - -164, 0, 167, 0, 0, 169, 0, -164, 172, 101, - 174, 0, 185, 0, 0, 198, 192, 0, 0, 201, - 202, 2245, 0, 0, 0, 11, 0, 17, 0, 19, - 0, 84, 2245, 139, 2245, 69, 91, 2245, 0, 153, - 0, 158, 0, 161, 0, 0, 0, 400, 101, 101, - 101, 0, 0, 2245, 101, 2245, 101, 2245, 247, 0, - 0, 0, 0, 105, 0, 1734, 175, 0, 261, 0, - 0, 0, 0, -215, -215, -156, 0, 269, -156, 279, - -215, 268, 101, 0, 0, 0, 0, 0, 0, 278, - 101, 0, 101, 0, 1850, -215, 0, -156, -215, 300, - 0, 0, 0, 101, 0, + 0, 0, -178, 0, 0, 0, -49, 0, 0, 0, + 0, 0, 616, 0, 0, 0, -108, -233, 3, 0, + -230, 0, 0, 0, -24, -24, 0, 28, 0, 1899, + 0, 0, -17, -12, -11, -10, -35, 1899, 39, 54, + 60, 992, 936, -24, 1055, 1319, -217, 0, 0, -24, + 1899, 1899, 1899, 1899, 1899, 1899, 1375, 0, 1899, 1899, + 1431, -24, -24, -24, -24, 1899, -161, 0, 277, 3829, + -69, -42, 0, 0, -4, 88, 89, 97, 0, 24, + 0, -107, 0, -105, 0, 0, 0, 0, 0, 1899, + 114, 1899, 328, 24, -107, 0, 24, 0, 24, 0, + 24, 0, 24, 0, 0, 115, 3829, 133, 1490, 936, + 0, 328, 0, -69, 97, 0, 1899, 0, 137, 0, + 328, -19, 56, 19, 1899, 0, 97, 98, 98, 98, + -82, -82, 93, -21, 98, 98, 0, -87, 0, 0, + 0, 0, 328, 24, 0, 1899, 1899, 1899, 1899, 1899, + 1899, 1899, 1899, 1899, 1899, 1899, 1899, 1899, 1899, 1899, + 1899, 1899, 1899, 1899, 1899, 1899, 0, 0, -32, 1899, + 1899, 1899, 1899, 1899, 1899, 1665, 0, 1899, 0, 0, + -8, 1899, 357, 0, 1899, 82, 1899, 24, 1899, -161, + 1899, -161, 1899, -234, 1899, -234, 144, 1724, 0, 0, + 0, 4, 11, 138, 1899, 97, 1780, 1836, 0, 61, + 0, 1899, 96, 0, 0, -176, -176, 0, -176, -176, + -95, 0, 21, 1092, 328, 373, 434, 92, 3829, 1204, + 3238, 3721, 2430, 815, 419, 98, 98, 1899, 0, 1899, + 0, 173, -80, 55, -68, 57, -54, 68, 0, 6, + 3829, 0, 0, 157, 0, 178, 0, 1899, 0, 0, + -176, 0, 181, 0, 0, 183, 0, -176, 190, 112, + 209, 0, 231, 0, 0, 210, 277, 0, 0, 237, + 224, 1899, 0, 0, 0, 9, 0, 15, 0, 17, + 0, 105, 1899, 163, 1899, 81, 119, 1899, 0, 168, + 0, 175, 0, 185, 0, 0, 0, 1146, 112, 112, + 112, 0, 0, 1899, 112, 1899, 112, 1899, 279, 0, + 0, 0, 0, 143, 0, 3863, 202, 0, 300, 0, + 0, 0, 0, -161, -161, -234, 0, 321, -234, 326, + -161, 309, 112, 0, 0, 0, 0, 0, 0, 398, + 112, 0, 112, 0, 1724, -161, 0, -234, -161, 336, + 0, 0, 0, 112, 0, }; short yyrindex[] = { 0, 0, 0, 220, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 2453, 2118, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 3021, - 3064, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 65, 0, -14, -29, - 3121, 3189, 0, 0, 2353, 2177, 0, 309, 0, 0, - 0, -33, 0, 0, 0, 0, 0, 0, 0, 2520, - 0, 0, 843, 0, 230, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 1177, 0, 0, 319, - 0, 2285, 0, 1241, 3121, 0, 0, 2520, 0, 2588, - 496, 557, 2651, 0, 0, 0, 1692, 674, 3387, 3470, - 110, 3299, 2719, 0, 3518, 3592, 0, 0, 0, 0, - 0, 0, 2038, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 2159, 1989, 0, + 0, 2799, 2867, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 65, 0, -25, 193, + 2910, 2954, 0, 0, 2225, 2048, 0, 333, 0, 0, + 0, 2, 0, 0, 0, 0, 0, 0, 0, 2284, + 0, 0, 3575, 0, 257, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 3017, 0, 0, 348, + 0, 3642, 496, 557, 2395, 0, 0, 0, 2111, 0, + 3695, 2910, 0, 0, 2284, 0, 2520, 3065, 3103, 3190, + 659, 2997, 2563, 0, 3301, 3354, 0, 0, 0, 0, + 0, 0, 3741, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 2786, 0, 0, - 0, 302, 892, 0, 319, 0, 2520, 0, 325, 65, - 0, 65, 0, 164, 0, 164, 0, 312, 0, 0, - 0, 0, 331, 0, 0, 0, 0, 0, 0, 0, - 2886, 0, 2954, 0, 0, 10, 12, 0, 34, 53, - 1047, 0, 0, 1185, 3811, 3827, 3719, 3767, 1294, 0, - 1636, 1580, 1129, 3871, -4, 3636, 3674, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 1572, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 59, 0, 0, 0, 0, 0, 0, 333, 0, 0, - 0, 0, 0, 0, 0, 0, 63, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 2631, 0, 0, + 0, 331, 880, 0, 348, 0, 2284, 0, 352, 65, + 0, 65, 0, 164, 0, 164, 0, 338, 0, 0, + 0, 0, 358, 0, 0, 2674, 0, 0, 0, 0, + 0, 0, 2718, 0, 0, -22, 36, 0, 91, 110, + -33, 0, 0, 2573, 1267, 1531, 3476, 3521, 3675, 0, + -27, 3826, 3794, 1587, -6, 3392, 3440, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 319, 0, 0, + 3787, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 134, 0, 0, 0, 0, 0, 0, 359, 0, 0, + 0, 0, 0, 0, 0, 0, 155, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 322, 0, 0, - 0, 0, 0, 0, 0, -23, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 348, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 349, 0, 0, + 0, 0, 0, 0, 0, 1953, 0, 0, 0, 0, 0, 0, 0, 65, 65, 164, 0, 0, 164, 0, - 65, 0, 0, 0, 0, 0, 0, 0, 0, 892, - 0, 0, 0, 0, 347, 65, 0, 164, 65, 0, + 65, 0, 0, 0, 0, 0, 0, 0, 0, 880, + 0, 0, 0, 0, 368, 65, 0, 164, 65, 0, 0, 0, 0, 0, 0, }; short yygindex[] = { 0, - 0, 0, 0, 60, -19, 0, 4247, 768, -83, 0, - 0, 0, -192, -13, 3466, 2324, 0, 0, 0, 0, - 0, 377, 955, 0, 0, 245, -173, 39, 75, 204, - -68, -168, 966, 0, 0, 313, 335, 0, 0, 0, + 0, 0, 0, 136, -29, 0, 4145, 680, -78, 0, + 0, 0, -193, -13, 3266, 519, 0, 0, 0, 0, + 0, 400, 885, 0, 0, 267, -196, 63, 124, 250, + -16, -167, 20, 0, 0, 320, 356, 0, 0, 0, 0, 0, 0, }; -#define YYTABLESIZE 4435 +#define YYTABLESIZE 4333 short yytable[] = { 69, - 62, 183, 209, 274, 105, 23, 20, 62, 214, 170, - 294, 68, 299, 170, 68, 207, 256, 91, 62, 213, - 91, 184, 252, 172, 280, 57, 15, 301, 68, 68, - 117, 82, 96, 98, 91, 91, 83, 84, 283, 83, - 174, 152, 100, 134, 15, 152, 83, 138, 305, 210, - 18, 320, 42, 83, 83, 171, 284, 321, 83, 322, - 118, 102, 144, 68, 27, 18, 172, 21, 18, 91, - 42, 92, 173, 240, 16, 255, 189, 108, 191, 300, - 193, 302, 195, 109, 197, 198, 23, 110, 83, 57, - 94, 95, 16, 17, 23, 202, 203, 27, 171, 41, - 27, 27, 27, 43, 27, 238, 27, 27, 319, 27, - 176, 17, 175, 254, 304, 23, 23, 41, 259, 270, - 271, 15, 177, 27, 178, 23, 23, 327, 27, 329, - 150, 151, 216, 217, 219, 220, 221, 222, 223, 80, - 338, 182, 340, 349, 23, 180, 352, 4, 5, 6, - 100, 7, 8, 100, 185, 27, 243, 244, 245, 246, - 247, 248, 250, 20, 199, 362, 200, 100, 100, 206, - 208, 203, 100, 212, 303, 261, 323, 217, 62, 282, - 285, 217, 291, 328, 277, 293, 151, 27, 298, 27, - 27, 286, 288, 290, 306, 307, 20, 344, 292, 20, - 20, 20, 100, 20, 19, 20, 20, 309, 20, 310, - 150, 151, 311, 314, 150, 151, 4, 5, 6, 2, - 7, 8, 20, 312, 296, 315, 297, 20, 86, 150, - 151, 166, 169, 87, 167, 168, 169, 316, 150, 151, - 239, 317, 68, 68, 68, 68, 150, 151, 91, 91, - 91, 91, 47, 350, 20, 47, 47, 47, 104, 47, - 318, 47, 47, 325, 47, 68, 68, 83, 83, 83, - 83, 91, 91, 150, 151, 91, 83, 330, 47, 324, - 83, 83, 331, 47, 203, 332, 20, 343, 20, 20, - 83, 83, 150, 151, 83, 83, 83, 83, 83, 345, - 83, 346, 150, 151, 261, 150, 151, 150, 151, 351, - 47, 150, 151, 150, 151, 150, 151, 150, 151, 353, - 27, 27, 27, 27, 27, 27, 355, 27, 27, 27, + 62, 280, 274, 62, 105, 214, 183, 64, 170, 20, + 64, 62, 299, 90, 23, 15, 90, 256, 18, 213, + 208, 172, 96, 82, 301, 64, 84, 98, 100, 102, + 90, 90, 124, 15, 83, 90, 18, 83, 303, 125, + 152, 270, 271, 134, 283, 91, 305, 138, 174, 320, + 252, 83, 83, 171, 284, 321, 83, 322, 240, 64, + 57, 83, 117, 118, 27, 90, 189, 92, 191, 126, + 193, 172, 195, 184, 197, 198, 42, 210, 108, 294, + 173, 139, 140, 141, 142, 319, 83, 4, 5, 6, + 238, 7, 8, 109, 42, 202, 203, 27, 23, 110, + 27, 27, 27, 171, 27, 23, 27, 27, 211, 27, + 23, 23, 23, 300, 23, 302, 144, 338, 175, 340, + 150, 151, 257, 27, 57, 258, 304, 176, 27, 205, + 329, 16, 216, 217, 219, 220, 221, 222, 223, 327, + 178, 18, 349, 21, 159, 352, 23, 177, 80, 16, + 17, 182, 180, 185, 199, 27, 243, 244, 245, 246, + 247, 248, 250, 20, 362, 254, 94, 95, 17, 282, + 259, 203, 170, 200, 41, 261, 207, 217, 285, 62, + 209, 217, 170, 212, 277, 291, 293, 27, 170, 27, + 27, 286, 41, 288, 290, 43, 20, 323, 292, 20, + 20, 20, 151, 20, 152, 20, 20, 19, 20, 150, + 151, 328, 298, 15, 152, 306, 150, 151, 307, 2, + 152, 309, 20, 310, 296, 239, 297, 20, 150, 151, + 311, 169, 86, 68, 312, 344, 68, 87, 64, 64, + 64, 64, 150, 151, 90, 90, 90, 90, 314, 316, + 68, 68, 47, 90, 20, 47, 47, 47, 350, 47, + 104, 47, 47, 64, 47, 83, 83, 83, 83, 90, + 90, 315, 90, 90, 83, 150, 151, 317, 47, 324, + 83, 83, 318, 47, 203, 68, 20, 325, 20, 20, + 83, 83, 330, 83, 83, 83, 83, 83, 83, 331, + 150, 151, 150, 151, 261, 150, 151, 150, 151, 332, + 47, 150, 151, 150, 151, 150, 151, 150, 151, 343, + 27, 27, 27, 27, 27, 27, 345, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, - 364, 69, 47, 27, 27, 47, 27, 27, 27, 65, - 150, 151, 57, 27, 27, 27, 27, 27, 27, 155, - 153, 27, 27, 150, 151, 40, 257, 65, 27, 258, - 38, 156, 27, 43, 27, 27, 150, 151, 150, 151, - 40, 100, 100, 100, 100, 150, 151, 38, 159, 77, - 100, 218, 342, 360, 100, 100, 100, 100, 273, 150, - 151, 65, 357, 0, 100, 100, 0, 188, 100, 100, - 100, 100, 100, 0, 100, 100, 170, 0, 100, 20, - 20, 20, 20, 20, 20, 0, 20, 20, 20, 20, - 20, 20, 20, 20, 20, 20, 20, 20, 20, 0, - 333, 0, 20, 20, 0, 20, 20, 20, 152, 170, - 0, 0, 20, 20, 20, 20, 20, 20, 0, 0, - 20, 20, 159, 146, 147, 148, 149, 20, 0, 0, + 346, 69, 47, 27, 27, 47, 27, 27, 27, 27, + 27, 150, 151, 150, 151, 27, 27, 27, 27, 27, + 27, 351, 153, 27, 150, 151, 353, 355, 154, 155, + 156, 157, 27, 65, 27, 27, 364, 150, 151, 57, + 156, 158, 160, 161, 162, 163, 164, 165, 155, 153, + 166, 65, 40, 167, 168, 169, 38, 165, 156, 43, + 166, 150, 151, 167, 168, 169, 166, 40, 38, 167, + 168, 169, 77, 218, 188, 150, 151, 360, 170, 20, + 20, 20, 20, 20, 20, 65, 20, 20, 20, 20, + 20, 20, 20, 20, 20, 20, 20, 20, 20, 150, + 151, 342, 20, 20, 273, 20, 20, 20, 20, 20, + 152, 0, 0, 0, 20, 20, 20, 20, 20, 20, + 0, 0, 20, 170, 68, 68, 68, 68, 0, 0, 0, 20, 0, 20, 20, 47, 47, 47, 47, 47, - 47, 152, 47, 47, 47, 0, 150, 151, 47, 0, - 170, 47, 47, 47, 47, 0, 0, 0, 47, 47, - 0, 47, 47, 47, 0, 0, 0, 0, 47, 47, - 47, 47, 47, 47, 0, 0, 47, 47, 0, 0, - 0, 0, 152, 47, 264, 170, 267, 47, 167, 47, + 47, 255, 47, 47, 47, 0, 0, 0, 47, 68, + 68, 47, 47, 47, 47, 152, 0, 0, 47, 47, + 0, 47, 47, 47, 47, 47, 0, 0, 0, 170, + 47, 47, 47, 47, 47, 47, 0, 0, 47, 0, + 0, 0, 357, 0, 170, 0, 0, 47, 167, 47, 47, 167, 167, 167, 0, 167, 151, 167, 167, 151, - 167, 0, 0, 4, 5, 6, 0, 7, 8, 0, - 0, 0, 0, 151, 151, 0, 0, 152, 151, 167, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 65, 65, 65, 65, 0, 0, 151, 0, 151, 168, + 167, 152, 0, 89, 89, 264, 0, 267, 146, 147, + 148, 149, 0, 151, 151, 106, 152, 0, 151, 167, + 0, 114, 89, 122, 0, 0, 0, 0, 89, 0, + 0, 0, 0, 150, 151, 0, 0, 0, 0, 0, + 89, 89, 89, 89, 0, 0, 151, 0, 151, 168, 0, 0, 168, 168, 168, 0, 168, 110, 168, 168, - 110, 168, 0, 65, 65, 0, 153, 0, 0, 0, - 154, 155, 156, 157, 110, 110, 0, 0, 151, 110, - 168, 167, 0, 0, 158, 160, 161, 162, 163, 0, - 164, 165, 0, 0, 166, 0, 0, 167, 168, 169, - 0, 0, 0, 154, 155, 156, 157, 0, 52, 110, - 0, 62, 64, 48, 0, 57, 0, 65, 60, 0, - 59, 163, 0, 164, 165, 0, 0, 166, 347, 348, - 167, 168, 169, 0, 58, 354, 0, 0, 0, 63, - 153, 0, 168, 0, 154, 155, 156, 157, 0, 0, - 361, 0, 0, 363, 0, 0, 0, 0, 158, 160, - 161, 162, 163, 0, 164, 165, 61, 0, 166, 0, - 0, 167, 168, 169, 95, 0, 0, 95, 0, 154, - 155, 156, 157, 0, 0, 0, 0, 0, 0, 0, - 0, 95, 95, 0, 0, 0, 95, 0, 23, 164, - 165, 53, 0, 166, 0, 0, 167, 168, 169, 0, - 0, 0, 167, 167, 167, 167, 167, 0, 167, 167, - 167, 0, 0, 0, 167, 0, 95, 151, 151, 151, + 110, 168, 0, 0, 65, 65, 65, 65, 0, 0, + 0, 0, 0, 0, 110, 110, 156, 157, 151, 110, + 168, 167, 4, 5, 6, 0, 7, 8, 114, 65, + 65, 0, 164, 165, 0, 0, 166, 0, 0, 167, + 168, 169, 0, 0, 0, 0, 0, 0, 52, 110, + 0, 62, 64, 50, 0, 57, 0, 65, 60, 154, + 59, 156, 157, 4, 5, 6, 0, 7, 8, 0, + 0, 0, 0, 0, 58, 0, 0, 164, 165, 63, + 0, 166, 168, 0, 167, 168, 169, 241, 0, 347, + 348, 0, 0, 0, 0, 0, 354, 0, 0, 100, + 0, 0, 100, 0, 0, 0, 61, 156, 157, 0, + 0, 361, 0, 0, 363, 275, 100, 100, 0, 0, + 0, 100, 0, 0, 165, 0, 0, 166, 0, 0, + 167, 168, 169, 0, 0, 0, 0, 0, 23, 165, + 0, 53, 166, 0, 0, 167, 168, 169, 0, 0, + 0, 100, 167, 167, 167, 167, 167, 0, 167, 167, + 167, 0, 0, 0, 167, 0, 0, 151, 151, 151, 151, 0, 0, 0, 0, 167, 151, 167, 167, 167, - 151, 151, 151, 151, 167, 167, 167, 167, 167, 167, - 151, 151, 167, 167, 151, 151, 151, 151, 151, 167, + 167, 167, 151, 151, 151, 151, 167, 167, 167, 167, + 167, 167, 151, 151, 167, 151, 151, 151, 151, 151, 151, 151, 0, 167, 151, 167, 167, 151, 151, 151, 0, 0, 0, 168, 168, 168, 168, 168, 0, 168, 168, 168, 0, 0, 0, 168, 0, 0, 110, 110, 110, 110, 0, 0, 0, 0, 168, 110, 168, 168, - 168, 110, 110, 110, 110, 168, 168, 168, 168, 168, - 168, 110, 110, 168, 168, 110, 110, 110, 110, 110, - 168, 110, 110, 0, 168, 110, 168, 168, 110, 110, + 168, 168, 168, 110, 110, 110, 110, 168, 168, 168, + 168, 168, 168, 110, 110, 168, 110, 110, 110, 110, + 110, 110, 110, 0, 168, 110, 168, 168, 110, 110, 110, 22, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 0, 0, 143, 32, 0, 143, 33, 34, 35, + 31, 0, 0, 0, 32, 0, 0, 33, 34, 35, 36, 0, 0, 0, 37, 38, 0, 39, 40, 41, - 143, 143, 0, 0, 42, 43, 44, 45, 46, 47, - 0, 0, 49, 50, 0, 0, 0, 0, 0, 51, - 0, 0, 0, 54, 47, 55, 56, 47, 47, 47, - 0, 47, 0, 47, 47, 143, 47, 0, 0, 0, - 0, 0, 0, 0, 0, 95, 95, 95, 95, 0, - 47, 0, 0, 0, 95, 47, 0, 0, 95, 95, - 95, 95, 0, 0, 0, 0, 0, 0, 95, 95, - 0, 0, 95, 95, 95, 95, 95, 0, 95, 95, - 52, 0, 47, 62, 64, 48, 0, 57, 0, 65, - 60, 91, 59, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 120, 123, 0, 0, 111, 0, 0, - 0, 63, 0, 119, 47, 125, 0, 47, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 139, 140, 141, - 142, 170, 0, 0, 0, 0, 52, 0, 61, 62, - 64, 48, 0, 57, 123, 65, 60, 0, 59, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 152, 0, 0, 0, 63, 0, 0, - 23, 0, 123, 53, 0, 205, 334, 335, 336, 211, - 0, 0, 339, 0, 341, 0, 0, 64, 0, 0, - 64, 0, 0, 0, 61, 0, 0, 0, 0, 52, - 0, 0, 62, 64, 48, 64, 57, 0, 65, 60, - 356, 59, 0, 0, 143, 143, 143, 143, 358, 0, - 359, 170, 0, 0, 0, 116, 23, 0, 0, 53, - 63, 365, 0, 0, 0, 0, 123, 143, 143, 64, - 0, 123, 0, 0, 0, 0, 0, 47, 47, 47, - 47, 47, 47, 152, 47, 47, 47, 61, 0, 0, - 47, 0, 0, 47, 47, 47, 47, 0, 0, 87, - 47, 47, 87, 47, 47, 47, 0, 0, 0, 0, - 47, 47, 47, 47, 47, 47, 87, 87, 47, 47, - 0, 87, 53, 0, 0, 47, 0, 0, 0, 47, - 0, 47, 47, 0, 121, 25, 26, 27, 28, 87, - 29, 30, 31, 0, 0, 0, 32, 138, 0, 0, - 138, 87, 0, 0, 0, 88, 0, 38, 88, 39, - 40, 41, 0, 0, 138, 138, 42, 43, 44, 45, - 46, 47, 88, 88, 49, 50, 165, 88, 0, 166, - 0, 51, 167, 168, 169, 54, 0, 55, 56, 0, - 112, 25, 26, 27, 28, 0, 29, 30, 31, 138, - 0, 0, 32, 0, 0, 0, 0, 88, 0, 0, - 170, 131, 0, 38, 131, 39, 40, 41, 0, 0, - 0, 0, 42, 43, 44, 45, 46, 47, 131, 131, - 49, 50, 0, 131, 0, 0, 0, 51, 0, 0, - 0, 54, 152, 55, 56, 0, 0, 156, 64, 64, - 64, 64, 0, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 0, 131, 79, 32, 165, 79, 0, 166, - 0, 64, 167, 168, 169, 0, 38, 0, 39, 40, - 41, 79, 79, 0, 0, 42, 43, 44, 45, 46, - 47, 0, 0, 49, 50, 0, 0, 0, 0, 0, - 51, 0, 0, 0, 54, 52, 55, 56, 62, 64, - 48, 0, 57, 0, 65, 60, 79, 59, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 87, 87, 87, 87, 0, 0, 63, 0, 0, 87, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 87, 87, 0, 0, 87, 87, 87, - 87, 52, 0, 61, 62, 64, 48, 0, 57, 133, - 65, 60, 0, 59, 0, 0, 0, 0, 138, 138, - 138, 138, 0, 0, 0, 0, 88, 88, 88, 88, - 0, 0, 63, 0, 0, 23, 0, 0, 53, 0, - 0, 138, 138, 0, 0, 0, 156, 157, 0, 88, - 88, 0, 0, 88, 0, 0, 0, 52, 0, 61, - 62, 64, 48, 0, 57, 165, 65, 60, 166, 59, - 0, 167, 168, 169, 0, 0, 0, 0, 0, 0, - 0, 0, 131, 131, 131, 131, 0, 0, 63, 0, - 0, 131, 0, 0, 53, 131, 131, 0, 0, 0, - 0, 0, 0, 0, 0, 131, 131, 0, 0, 131, - 131, 131, 131, 131, 0, 61, 0, 137, 0, 0, - 52, 0, 0, 62, 64, 48, 0, 57, 201, 65, - 60, 0, 59, 0, 0, 79, 79, 79, 79, 0, + 42, 43, 0, 0, 0, 170, 44, 45, 46, 47, + 48, 49, 47, 0, 51, 47, 47, 47, 0, 47, + 0, 47, 47, 54, 47, 55, 56, 115, 0, 0, + 100, 100, 100, 100, 0, 127, 0, 152, 47, 100, + 0, 0, 0, 47, 0, 100, 100, 100, 100, 0, + 0, 0, 0, 0, 0, 100, 100, 0, 100, 100, + 100, 100, 100, 100, 100, 0, 0, 100, 52, 0, + 47, 62, 64, 50, 115, 57, 0, 65, 60, 0, + 59, 0, 0, 0, 0, 0, 0, 0, 334, 335, + 336, 0, 0, 0, 339, 0, 341, 0, 0, 63, + 0, 206, 47, 0, 0, 47, 0, 0, 0, 115, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 53, 63, 0, 0, 0, 0, 0, 0, 79, 79, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 61, 0, - 0, 32, 67, 0, 0, 67, 0, 0, 0, 0, - 89, 0, 38, 89, 39, 40, 41, 0, 0, 67, - 67, 42, 43, 44, 45, 46, 47, 89, 89, 49, - 50, 0, 89, 53, 0, 0, 51, 0, 0, 0, - 54, 0, 55, 56, 0, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 67, 0, 0, 32, 0, 0, - 0, 0, 89, 0, 0, 0, 90, 0, 38, 90, - 39, 40, 41, 0, 0, 0, 0, 42, 43, 44, - 45, 46, 47, 90, 90, 49, 50, 0, 90, 0, - 0, 0, 51, 0, 0, 0, 54, 0, 55, 56, - 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, - 0, 0, 0, 32, 0, 0, 0, 0, 90, 0, - 0, 0, 142, 0, 38, 142, 39, 40, 41, 0, - 0, 0, 0, 42, 43, 44, 45, 46, 47, 142, - 142, 49, 50, 0, 142, 0, 0, 0, 51, 0, - 0, 0, 54, 0, 55, 56, 0, 0, 0, 0, - 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 0, 142, 0, 32, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 159, 38, 0, 39, - 40, 41, 0, 0, 0, 0, 42, 43, 44, 45, - 46, 47, 0, 0, 49, 50, 0, 0, 0, 0, - 0, 51, 0, 0, 170, 54, 52, 55, 56, 62, - 64, 48, 0, 57, 249, 65, 60, 0, 59, 0, - 0, 0, 0, 67, 67, 67, 67, 0, 0, 0, - 0, 89, 89, 89, 89, 0, 152, 63, 0, 0, - 89, 0, 0, 0, 0, 0, 67, 67, 0, 0, - 0, 0, 0, 0, 89, 89, 0, 0, 89, 89, - 89, 0, 52, 0, 61, 62, 64, 48, 0, 57, - 0, 65, 60, 0, 59, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 90, 90, 90, - 90, 0, 0, 63, 0, 0, 90, 0, 0, 53, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 90, 90, 0, 0, 90, 90, 0, 0, 52, 0, - 61, 62, 64, 48, 0, 57, 287, 65, 60, 0, - 59, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 142, 142, 142, 142, 0, 0, 63, - 0, 0, 142, 0, 0, 53, 142, 142, 0, 0, - 0, 0, 0, 0, 0, 0, 142, 142, 0, 0, - 142, 142, 142, 142, 142, 0, 61, 0, 0, 0, - 0, 52, 0, 0, 62, 64, 48, 0, 57, 289, - 65, 60, 0, 59, 153, 0, 0, 0, 154, 155, - 156, 157, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 53, 63, 160, 161, 162, 163, 0, 164, 165, + 0, 0, 356, 0, 52, 0, 61, 62, 64, 50, + 358, 57, 359, 65, 60, 0, 59, 0, 0, 0, + 0, 0, 0, 365, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 63, 0, 0, 23, 0, + 0, 53, 0, 0, 0, 0, 115, 0, 0, 0, + 0, 115, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 61, 0, 0, 0, 0, 52, 0, 0, + 62, 64, 50, 0, 57, 0, 65, 60, 0, 59, + 0, 154, 155, 156, 157, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 23, 0, 0, 53, 63, 164, + 165, 0, 0, 166, 0, 0, 167, 168, 169, 0, + 0, 0, 0, 0, 0, 47, 47, 47, 47, 47, + 47, 0, 47, 47, 47, 61, 0, 0, 47, 0, + 0, 47, 47, 47, 47, 0, 0, 0, 47, 47, + 0, 47, 47, 47, 47, 47, 0, 0, 0, 0, + 47, 47, 47, 47, 47, 47, 0, 23, 47, 0, + 53, 0, 170, 0, 0, 0, 333, 47, 0, 47, + 47, 0, 113, 25, 26, 27, 28, 87, 29, 30, + 31, 0, 0, 0, 32, 0, 0, 0, 159, 0, + 0, 0, 0, 0, 152, 38, 0, 39, 40, 41, + 42, 43, 0, 0, 0, 0, 44, 45, 46, 47, + 48, 49, 0, 0, 51, 0, 170, 0, 0, 0, + 0, 0, 0, 54, 0, 55, 56, 0, 24, 25, + 26, 27, 28, 0, 29, 30, 31, 0, 0, 0, + 32, 295, 0, 0, 0, 0, 159, 0, 152, 0, + 0, 38, 0, 39, 40, 41, 42, 43, 0, 0, + 0, 0, 44, 45, 46, 47, 48, 49, 0, 0, + 51, 0, 0, 0, 170, 0, 0, 0, 0, 54, + 0, 55, 56, 0, 0, 0, 0, 84, 0, 0, + 84, 119, 25, 26, 27, 28, 0, 29, 30, 31, + 0, 0, 0, 32, 84, 84, 152, 0, 0, 84, + 0, 0, 0, 0, 38, 0, 39, 40, 41, 42, + 43, 0, 0, 0, 0, 44, 45, 46, 47, 48, + 49, 52, 0, 51, 62, 64, 50, 0, 57, 84, + 65, 60, 54, 59, 55, 56, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 123, 154, 155, + 156, 157, 63, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 160, 161, 162, 163, 164, 165, 0, 0, + 166, 0, 0, 167, 168, 169, 0, 52, 0, 61, + 62, 64, 50, 0, 57, 133, 65, 60, 0, 59, + 0, 0, 0, 0, 0, 0, 153, 0, 0, 0, + 0, 0, 154, 155, 156, 157, 0, 0, 63, 0, + 0, 0, 0, 0, 53, 158, 160, 161, 162, 163, + 164, 165, 0, 0, 166, 0, 0, 167, 168, 169, + 0, 0, 0, 52, 0, 61, 62, 64, 50, 0, + 57, 0, 65, 60, 0, 59, 0, 0, 0, 0, + 0, 0, 0, 0, 153, 0, 0, 0, 0, 0, + 154, 155, 156, 157, 63, 0, 0, 0, 0, 0, + 53, 0, 0, 158, 160, 161, 162, 163, 164, 165, 0, 0, 166, 0, 0, 167, 168, 169, 0, 0, - 24, 25, 26, 27, 28, 0, 29, 30, 31, 61, - 0, 0, 32, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 38, 0, 39, 40, 41, 102, 0, - 0, 102, 42, 43, 44, 45, 46, 47, 0, 0, - 49, 50, 0, 0, 53, 102, 102, 51, 0, 0, - 102, 54, 0, 55, 56, 22, 24, 25, 26, 27, - 28, 0, 29, 30, 31, 0, 0, 0, 32, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, - 102, 39, 40, 41, 0, 0, 0, 0, 42, 43, - 44, 45, 46, 47, 0, 0, 49, 50, 0, 0, - 0, 0, 0, 51, 0, 0, 0, 54, 144, 55, - 56, 144, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 0, 0, 0, 32, 144, 144, 0, 0, 0, - 144, 0, 0, 0, 0, 38, 0, 39, 40, 41, - 0, 0, 0, 0, 42, 43, 44, 45, 46, 47, - 0, 0, 49, 50, 0, 0, 0, 0, 144, 51, - 144, 0, 0, 54, 0, 55, 56, 127, 0, 0, - 127, 0, 0, 0, 0, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 127, 127, 0, 32, 0, 127, - 144, 0, 0, 0, 0, 0, 0, 0, 38, 0, - 39, 40, 41, 0, 0, 0, 0, 42, 43, 44, - 45, 46, 47, 0, 0, 49, 50, 127, 0, 127, - 0, 0, 51, 0, 0, 0, 54, 52, 55, 56, - 62, 64, 48, 0, 57, 0, 65, 60, 0, 59, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 127, - 0, 0, 0, 0, 0, 0, 0, 0, 63, 102, - 102, 102, 102, 0, 0, 0, 0, 0, 102, 0, - 0, 0, 102, 102, 0, 151, 0, 0, 151, 0, - 0, 0, 102, 102, 0, 61, 102, 102, 102, 102, - 102, 0, 151, 151, 0, 0, 0, 151, 89, 89, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 106, 0, 0, 0, 0, 89, 115, 0, 0, 0, - 53, 89, 0, 122, 0, 151, 0, 151, 0, 0, - 0, 0, 0, 0, 0, 89, 89, 89, 89, 144, - 144, 144, 144, 112, 0, 170, 112, 0, 144, 0, - 0, 0, 144, 144, 144, 144, 0, 151, 0, 0, - 112, 112, 144, 144, 0, 112, 144, 144, 144, 144, - 144, 0, 144, 144, 0, 0, 144, 152, 0, 144, - 144, 144, 0, 122, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 112, 0, 112, 0, 0, 127, 127, - 127, 127, 0, 0, 0, 0, 0, 127, 0, 0, - 0, 127, 127, 127, 127, 0, 0, 0, 0, 0, - 0, 127, 127, 0, 170, 127, 127, 127, 127, 127, - 0, 127, 127, 0, 0, 127, 0, 0, 127, 127, - 127, 0, 241, 137, 0, 0, 137, 0, 0, 0, - 0, 24, 25, 26, 27, 28, 152, 29, 30, 31, - 137, 137, 0, 32, 0, 137, 0, 0, 0, 0, - 275, 0, 0, 0, 38, 0, 39, 40, 41, 0, - 0, 0, 0, 42, 43, 44, 45, 46, 47, 0, - 0, 49, 50, 0, 0, 137, 0, 0, 51, 0, - 0, 0, 54, 0, 55, 56, 151, 151, 151, 151, - 153, 0, 0, 153, 0, 151, 0, 0, 0, 151, - 151, 151, 151, 0, 0, 137, 0, 153, 153, 151, - 151, 0, 153, 151, 151, 151, 151, 151, 0, 151, - 151, 156, 157, 151, 0, 0, 151, 151, 151, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 164, - 165, 0, 153, 166, 0, 0, 167, 168, 169, 0, - 0, 0, 0, 0, 112, 112, 112, 112, 139, 0, - 0, 0, 0, 112, 0, 0, 0, 112, 112, 112, - 112, 0, 153, 0, 0, 139, 139, 112, 112, 0, - 139, 112, 112, 112, 112, 112, 0, 112, 112, 0, - 0, 112, 0, 0, 112, 112, 112, 0, 154, 155, - 156, 157, 0, 0, 0, 0, 0, 0, 139, 0, - 139, 0, 0, 160, 161, 162, 163, 0, 164, 165, - 0, 154, 166, 0, 0, 167, 168, 169, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 154, 154, - 139, 0, 0, 154, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 137, 137, 137, 137, 0, 0, - 0, 0, 0, 137, 0, 0, 0, 137, 137, 137, - 137, 154, 0, 154, 0, 0, 0, 137, 137, 0, - 0, 137, 137, 137, 137, 137, 0, 137, 137, 104, - 0, 137, 104, 0, 137, 137, 137, 0, 0, 0, - 0, 0, 0, 154, 0, 0, 104, 104, 0, 0, - 0, 104, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 153, 153, 153, 153, 0, 0, 0, 0, 0, - 153, 0, 0, 0, 153, 153, 153, 153, 0, 0, - 0, 104, 0, 0, 153, 153, 0, 0, 153, 153, - 153, 153, 153, 0, 153, 153, 66, 0, 153, 66, - 0, 153, 153, 153, 0, 0, 0, 0, 0, 0, - 0, 104, 0, 66, 66, 0, 0, 0, 66, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 139, - 139, 139, 139, 0, 0, 0, 0, 0, 139, 0, - 0, 0, 139, 139, 139, 139, 0, 0, 66, 0, - 0, 0, 139, 139, 0, 0, 139, 139, 139, 139, - 139, 0, 139, 139, 0, 0, 139, 0, 0, 139, - 139, 139, 0, 0, 0, 0, 0, 0, 66, 170, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 154, 154, 154, 154, 69, 0, 0, 0, - 0, 154, 0, 0, 0, 154, 154, 154, 154, 0, - 0, 152, 0, 69, 69, 154, 154, 0, 69, 154, - 154, 154, 154, 154, 0, 154, 154, 0, 0, 154, - 0, 0, 154, 154, 154, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 69, 0, 69, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 104, 104, 104, 104, 103, 0, 0, 103, 0, 104, - 0, 0, 0, 104, 104, 104, 104, 0, 69, 0, - 0, 103, 103, 104, 104, 0, 103, 104, 104, 104, - 104, 104, 0, 104, 104, 0, 0, 104, 0, 0, - 104, 104, 104, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 103, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 66, 66, 66, - 66, 153, 0, 0, 153, 0, 66, 0, 0, 0, - 66, 66, 66, 66, 0, 0, 103, 0, 153, 153, - 66, 66, 0, 153, 66, 66, 66, 66, 66, 0, - 66, 66, 0, 0, 66, 0, 0, 66, 66, 66, - 0, 0, 0, 154, 140, 156, 157, 140, 0, 0, - 0, 0, 0, 153, 0, 0, 0, 0, 0, 0, - 0, 140, 140, 164, 165, 0, 140, 166, 0, 0, - 167, 168, 169, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 140, 69, 69, 69, - 69, 110, 0, 0, 110, 0, 69, 0, 0, 0, - 69, 69, 69, 69, 0, 0, 0, 0, 110, 110, - 69, 69, 0, 110, 69, 69, 69, 69, 69, 0, - 69, 69, 0, 0, 69, 0, 0, 69, 69, 69, + 0, 61, 52, 137, 0, 62, 64, 50, 0, 57, + 201, 65, 60, 0, 59, 0, 0, 0, 84, 84, + 84, 84, 0, 0, 0, 0, 0, 84, 0, 0, + 0, 0, 0, 63, 84, 0, 53, 0, 0, 0, + 0, 0, 0, 84, 84, 0, 84, 84, 84, 84, + 84, 85, 0, 0, 85, 24, 25, 26, 27, 28, + 61, 29, 30, 31, 0, 0, 0, 32, 85, 85, + 0, 0, 0, 85, 0, 0, 0, 0, 38, 0, + 39, 40, 41, 42, 43, 0, 0, 0, 0, 44, + 45, 46, 47, 48, 49, 53, 0, 51, 0, 0, + 0, 0, 0, 85, 0, 0, 54, 86, 55, 56, + 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 0, 0, 0, 32, 86, 86, 0, 0, 0, 86, + 0, 0, 0, 0, 38, 0, 39, 40, 41, 42, + 43, 0, 0, 0, 0, 44, 45, 46, 47, 48, + 49, 0, 0, 51, 0, 0, 0, 0, 0, 86, + 0, 0, 54, 0, 55, 56, 0, 24, 25, 26, + 27, 28, 0, 29, 30, 31, 0, 52, 0, 32, + 62, 64, 50, 0, 57, 249, 65, 60, 0, 59, + 38, 0, 39, 40, 41, 42, 43, 0, 0, 0, + 0, 44, 45, 46, 47, 48, 49, 0, 63, 51, + 0, 0, 0, 0, 0, 0, 0, 0, 54, 0, + 55, 56, 0, 0, 0, 0, 24, 25, 26, 27, + 28, 0, 29, 30, 31, 61, 52, 0, 32, 62, + 64, 50, 0, 57, 0, 65, 60, 0, 59, 38, + 0, 39, 40, 41, 42, 43, 0, 0, 0, 0, + 44, 45, 46, 47, 48, 49, 0, 63, 51, 0, + 53, 0, 0, 0, 0, 0, 0, 54, 0, 55, + 56, 0, 85, 85, 85, 85, 0, 0, 0, 0, + 0, 85, 52, 0, 61, 62, 64, 50, 0, 57, + 287, 65, 60, 0, 59, 0, 0, 85, 85, 0, + 85, 85, 85, 85, 85, 0, 0, 0, 0, 0, + 0, 0, 0, 63, 0, 0, 0, 0, 0, 53, + 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, + 86, 86, 0, 0, 0, 0, 0, 86, 52, 0, + 61, 62, 64, 50, 0, 57, 289, 65, 60, 0, + 59, 0, 0, 86, 86, 0, 86, 86, 86, 86, + 86, 0, 0, 0, 0, 0, 0, 0, 0, 63, + 0, 0, 0, 0, 0, 53, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 110, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 103, 103, 103, 103, 117, - 0, 0, 117, 0, 103, 0, 0, 0, 103, 103, - 103, 103, 0, 0, 0, 0, 117, 117, 103, 103, - 0, 117, 103, 103, 103, 103, 103, 0, 103, 103, - 0, 0, 103, 0, 0, 103, 103, 103, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 117, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 153, 153, 153, 153, 0, 0, 0, 0, - 0, 153, 0, 0, 0, 153, 153, 153, 153, 0, - 0, 0, 0, 0, 0, 153, 153, 0, 0, 153, - 153, 153, 153, 153, 0, 153, 153, 0, 0, 153, - 0, 0, 153, 153, 153, 140, 140, 140, 140, 101, - 0, 0, 101, 0, 140, 0, 0, 0, 140, 140, - 140, 140, 0, 0, 0, 0, 101, 101, 140, 140, - 0, 101, 140, 140, 140, 140, 140, 0, 140, 140, - 0, 0, 140, 0, 0, 140, 140, 140, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 101, 110, 110, 110, 110, 0, 0, 0, 0, - 0, 110, 0, 0, 0, 110, 110, 110, 110, 0, - 0, 0, 0, 0, 0, 110, 110, 0, 0, 110, - 110, 110, 110, 110, 0, 110, 110, 96, 0, 110, - 96, 0, 110, 110, 110, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 96, 96, 0, 0, 0, 96, + 0, 24, 25, 26, 27, 28, 61, 29, 30, 31, + 0, 52, 0, 32, 62, 64, 50, 0, 57, 0, + 65, 60, 0, 59, 38, 0, 39, 40, 41, 42, + 43, 0, 0, 0, 0, 44, 45, 46, 47, 48, + 49, 53, 63, 51, 0, 0, 0, 0, 0, 0, + 0, 0, 54, 0, 55, 56, 0, 0, 0, 22, + 24, 25, 26, 27, 28, 0, 29, 30, 31, 61, + 0, 0, 32, 91, 0, 0, 91, 0, 0, 0, + 0, 0, 0, 38, 0, 39, 40, 41, 42, 43, + 91, 91, 0, 0, 44, 45, 46, 47, 48, 49, + 0, 0, 51, 0, 53, 0, 0, 0, 0, 144, + 0, 54, 144, 55, 56, 0, 24, 25, 26, 27, + 28, 0, 29, 30, 31, 91, 144, 144, 32, 0, + 0, 144, 0, 0, 0, 0, 0, 0, 0, 38, + 0, 39, 40, 41, 42, 43, 0, 0, 0, 0, + 44, 45, 46, 47, 48, 49, 0, 0, 51, 144, + 0, 144, 0, 0, 0, 0, 0, 54, 127, 55, + 56, 127, 24, 25, 26, 27, 28, 0, 29, 30, + 31, 0, 0, 0, 32, 127, 127, 0, 0, 0, + 127, 144, 0, 0, 0, 38, 0, 39, 40, 41, + 42, 43, 0, 0, 0, 0, 44, 45, 46, 47, + 48, 49, 0, 0, 51, 0, 0, 0, 127, 0, + 127, 0, 0, 54, 0, 55, 56, 0, 0, 0, + 0, 151, 0, 0, 151, 24, 25, 26, 27, 28, + 0, 29, 30, 31, 0, 0, 0, 32, 151, 151, + 127, 0, 0, 151, 0, 0, 0, 0, 38, 0, + 39, 40, 41, 42, 43, 0, 0, 0, 0, 44, + 45, 46, 47, 48, 49, 0, 0, 51, 0, 137, + 0, 151, 137, 151, 0, 0, 54, 0, 55, 56, + 0, 0, 0, 0, 0, 0, 137, 137, 0, 0, + 0, 137, 0, 0, 91, 91, 91, 91, 0, 0, + 0, 0, 0, 151, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 91, + 91, 137, 91, 0, 0, 0, 0, 0, 0, 0, + 144, 144, 144, 144, 0, 112, 0, 0, 112, 144, + 0, 0, 0, 0, 0, 144, 144, 144, 144, 0, + 0, 137, 112, 112, 0, 144, 144, 112, 144, 144, + 144, 144, 144, 144, 144, 0, 0, 144, 0, 0, + 144, 144, 144, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 112, 0, 112, 0, 127, + 127, 127, 127, 0, 153, 0, 0, 153, 127, 0, + 0, 0, 0, 0, 127, 127, 127, 127, 0, 0, + 0, 153, 153, 0, 127, 127, 153, 127, 127, 127, + 127, 127, 127, 127, 0, 0, 127, 0, 0, 127, + 127, 127, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 153, 0, 0, 0, + 0, 0, 151, 151, 151, 151, 0, 0, 0, 0, + 0, 151, 0, 0, 0, 0, 0, 151, 151, 151, + 151, 0, 0, 0, 0, 0, 153, 151, 151, 0, + 151, 151, 151, 151, 151, 151, 151, 0, 0, 151, + 0, 0, 151, 151, 151, 0, 0, 0, 0, 0, + 137, 137, 137, 137, 0, 154, 0, 0, 0, 137, + 0, 0, 0, 0, 0, 137, 137, 137, 137, 0, + 0, 0, 154, 154, 0, 137, 137, 154, 137, 137, + 137, 137, 137, 137, 137, 0, 0, 137, 0, 0, + 137, 137, 137, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 154, 0, 154, 0, 0, + 0, 0, 0, 0, 0, 0, 112, 112, 112, 112, + 0, 0, 0, 0, 0, 112, 0, 0, 0, 0, + 0, 112, 112, 112, 112, 0, 0, 154, 0, 0, + 170, 112, 112, 0, 112, 112, 112, 112, 112, 112, + 112, 0, 0, 112, 0, 0, 112, 112, 112, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 117, 117, 117, 117, 0, 0, 0, 0, 0, 117, - 0, 0, 0, 117, 117, 117, 117, 0, 0, 96, - 0, 0, 0, 117, 117, 0, 0, 117, 117, 117, - 117, 117, 0, 117, 117, 93, 0, 117, 0, 0, - 117, 117, 117, 107, 0, 0, 0, 0, 114, 0, - 97, 0, 0, 97, 0, 0, 127, 128, 129, 130, - 131, 132, 0, 0, 135, 136, 0, 97, 97, 0, - 0, 143, 97, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 152, 0, 0, 153, 153, 153, 153, 0, + 139, 0, 0, 0, 153, 0, 0, 0, 0, 0, + 153, 153, 153, 153, 0, 0, 0, 139, 139, 0, + 153, 153, 139, 153, 153, 153, 153, 153, 153, 153, + 0, 0, 153, 0, 0, 153, 153, 153, 0, 0, + 0, 0, 0, 104, 0, 0, 104, 0, 0, 0, + 139, 0, 139, 88, 0, 0, 88, 0, 0, 0, + 104, 104, 0, 0, 0, 104, 0, 0, 0, 0, + 88, 88, 0, 0, 0, 88, 0, 0, 0, 0, + 0, 0, 139, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 104, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 88, 154, 154, 154, 154, + 0, 66, 0, 0, 66, 154, 0, 0, 0, 0, + 0, 154, 154, 154, 154, 104, 0, 0, 66, 66, + 0, 154, 154, 66, 154, 154, 154, 154, 154, 154, + 154, 0, 0, 154, 0, 0, 154, 154, 154, 0, + 0, 0, 0, 0, 69, 0, 154, 155, 156, 157, + 0, 0, 0, 66, 0, 0, 0, 0, 0, 0, + 0, 69, 69, 163, 164, 165, 69, 0, 166, 0, + 0, 167, 168, 169, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 66, 0, 0, 0, 0, 103, 0, + 0, 103, 0, 0, 69, 0, 69, 0, 0, 0, + 0, 0, 0, 0, 0, 103, 103, 0, 0, 0, + 103, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 139, 139, 139, 139, 0, 69, 0, 0, 0, + 139, 0, 0, 0, 0, 0, 139, 139, 139, 139, + 103, 0, 0, 0, 0, 0, 139, 139, 0, 139, + 139, 139, 139, 139, 139, 139, 0, 0, 139, 0, + 0, 139, 139, 139, 104, 104, 104, 104, 0, 140, + 103, 0, 140, 104, 88, 88, 88, 88, 0, 104, + 104, 104, 104, 0, 0, 0, 140, 140, 0, 104, + 104, 140, 104, 104, 104, 104, 104, 104, 104, 88, + 88, 104, 88, 0, 104, 104, 104, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 186, 93, 0, - 0, 93, 97, 0, 0, 0, 0, 0, 0, 0, - 101, 101, 101, 101, 0, 93, 93, 0, 0, 101, - 93, 0, 0, 101, 101, 101, 101, 0, 0, 0, - 0, 0, 0, 101, 101, 0, 0, 101, 101, 101, - 101, 101, 0, 101, 101, 0, 0, 101, 0, 0, - 93, 0, 0, 0, 0, 0, 0, 0, 224, 225, + 0, 140, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 66, 66, 66, 66, 0, 153, 0, 0, + 153, 66, 0, 0, 0, 0, 0, 66, 66, 66, + 66, 0, 0, 0, 153, 153, 0, 66, 66, 153, + 66, 66, 66, 66, 66, 66, 66, 0, 0, 66, + 0, 0, 66, 66, 66, 69, 69, 69, 69, 0, + 110, 0, 0, 110, 69, 0, 0, 0, 0, 153, + 69, 69, 69, 69, 0, 0, 0, 110, 110, 0, + 69, 69, 110, 69, 69, 69, 69, 69, 69, 69, + 0, 0, 69, 0, 0, 69, 69, 69, 0, 103, + 103, 103, 103, 0, 117, 0, 0, 117, 103, 0, + 0, 0, 110, 0, 103, 103, 103, 103, 0, 0, + 0, 117, 117, 0, 103, 103, 117, 103, 103, 103, + 103, 103, 103, 103, 0, 0, 103, 0, 0, 103, + 103, 103, 0, 0, 0, 0, 0, 101, 0, 0, + 101, 0, 0, 0, 0, 0, 117, 0, 0, 0, + 0, 0, 0, 0, 101, 101, 0, 138, 0, 101, + 138, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 140, 140, 140, 140, 138, 138, 0, 0, 0, 140, + 0, 0, 0, 0, 0, 140, 140, 140, 140, 101, + 0, 0, 0, 0, 0, 140, 140, 0, 140, 140, + 140, 140, 140, 140, 140, 95, 0, 140, 95, 138, + 140, 140, 140, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 95, 95, 0, 0, 0, 95, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 153, 153, + 153, 153, 0, 96, 0, 0, 96, 153, 0, 0, + 0, 0, 0, 153, 153, 153, 153, 95, 0, 0, + 96, 96, 0, 153, 153, 96, 153, 153, 153, 153, + 153, 153, 153, 0, 0, 153, 0, 0, 153, 153, + 153, 110, 110, 110, 110, 0, 0, 0, 0, 0, + 110, 0, 0, 0, 0, 96, 110, 110, 110, 110, + 0, 0, 0, 0, 0, 0, 110, 110, 0, 110, + 110, 110, 110, 110, 110, 110, 0, 0, 110, 0, + 0, 110, 110, 110, 0, 117, 117, 117, 117, 0, + 97, 0, 0, 97, 117, 0, 0, 0, 0, 0, + 117, 117, 117, 117, 0, 0, 0, 97, 97, 0, + 117, 117, 97, 117, 117, 117, 117, 117, 117, 117, + 0, 0, 117, 0, 0, 117, 117, 117, 101, 101, + 101, 101, 0, 0, 0, 0, 0, 101, 0, 0, + 0, 0, 97, 101, 101, 101, 101, 0, 138, 138, + 138, 138, 0, 101, 101, 93, 101, 101, 101, 101, + 101, 101, 101, 107, 0, 101, 0, 112, 0, 0, + 121, 0, 0, 138, 138, 0, 0, 128, 129, 130, + 131, 132, 0, 0, 135, 136, 0, 0, 170, 0, + 0, 143, 0, 0, 0, 0, 95, 95, 95, 95, + 0, 93, 0, 0, 93, 95, 0, 0, 0, 0, + 0, 95, 95, 95, 95, 0, 0, 186, 93, 93, + 152, 95, 95, 93, 95, 95, 95, 95, 95, 95, + 95, 0, 0, 0, 96, 96, 96, 96, 0, 0, + 0, 0, 0, 96, 0, 0, 0, 0, 0, 96, + 96, 96, 96, 93, 94, 0, 0, 94, 0, 96, + 96, 0, 96, 96, 96, 96, 96, 96, 96, 0, + 0, 94, 94, 0, 0, 0, 94, 0, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, - 236, 237, 94, 0, 0, 94, 0, 0, 0, 0, - 0, 0, 0, 251, 0, 0, 0, 0, 0, 94, - 94, 0, 0, 0, 94, 0, 0, 0, 96, 96, - 96, 96, 0, 0, 0, 0, 0, 96, 0, 0, - 0, 96, 96, 96, 96, 0, 92, 0, 0, 92, - 0, 96, 96, 0, 94, 96, 96, 96, 96, 96, - 0, 96, 96, 92, 92, 0, 0, 0, 92, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 80, 0, 0, 80, 0, 0, - 0, 0, 0, 308, 0, 0, 0, 0, 92, 0, - 0, 80, 80, 0, 0, 0, 80, 0, 0, 0, + 236, 237, 92, 0, 0, 92, 0, 0, 0, 0, + 0, 0, 0, 251, 0, 0, 94, 0, 0, 92, + 92, 0, 0, 0, 92, 0, 0, 0, 0, 0, 0, 97, 97, 97, 97, 0, 0, 0, 0, 0, - 97, 0, 0, 0, 97, 97, 97, 97, 0, 81, - 326, 0, 81, 0, 97, 97, 80, 0, 97, 97, - 97, 97, 97, 0, 97, 97, 81, 81, 0, 0, - 0, 81, 0, 0, 0, 0, 0, 0, 0, 93, - 93, 93, 93, 0, 0, 0, 0, 0, 93, 0, - 0, 0, 93, 93, 93, 93, 0, 82, 0, 0, - 82, 81, 93, 93, 170, 0, 93, 93, 93, 93, - 93, 0, 93, 93, 82, 82, 0, 0, 0, 82, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 152, 0, 0, 0, - 0, 84, 0, 0, 84, 0, 0, 0, 0, 82, - 0, 0, 0, 94, 94, 94, 94, 85, 84, 84, - 85, 0, 94, 84, 0, 0, 94, 94, 94, 94, - 0, 0, 0, 0, 85, 85, 94, 94, 0, 85, - 94, 94, 94, 94, 94, 0, 94, 94, 0, 0, - 0, 0, 0, 84, 0, 0, 0, 92, 92, 92, - 92, 86, 0, 0, 86, 0, 92, 0, 0, 85, - 92, 92, 92, 92, 0, 0, 0, 0, 86, 86, - 92, 92, 0, 86, 92, 92, 92, 92, 92, 0, - 92, 92, 0, 0, 0, 80, 80, 80, 80, 0, - 0, 295, 0, 0, 80, 0, 159, 0, 80, 80, - 80, 80, 0, 86, 0, 0, 0, 0, 80, 80, - 0, 0, 80, 80, 80, 80, 80, 0, 80, 80, - 0, 0, 0, 0, 170, 0, 0, 0, 0, 0, - 81, 81, 81, 81, 0, 0, 159, 0, 0, 81, - 0, 0, 0, 81, 81, 81, 81, 0, 154, 155, - 156, 157, 0, 81, 81, 0, 152, 81, 81, 81, - 81, 81, 0, 81, 170, 162, 163, 0, 164, 165, - 0, 0, 166, 0, 0, 167, 168, 169, 82, 82, - 82, 82, 0, 0, 0, 0, 0, 82, 0, 0, - 0, 82, 82, 0, 82, 170, 152, 0, 0, 0, - 0, 82, 82, 0, 0, 82, 82, 82, 82, 82, - 0, 82, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 84, 84, 84, 84, 0, 152, 0, 0, - 0, 84, 0, 0, 0, 0, 84, 0, 85, 85, - 85, 85, 0, 0, 0, 84, 84, 85, 0, 84, - 84, 84, 84, 84, 0, 0, 0, 0, 0, 0, - 0, 85, 85, 0, 0, 85, 85, 85, 85, 85, + 97, 0, 0, 0, 0, 0, 97, 97, 97, 97, + 80, 0, 0, 80, 92, 0, 97, 97, 0, 97, + 97, 97, 97, 97, 97, 97, 0, 80, 80, 0, + 0, 0, 80, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 81, 0, 0, 81, + 0, 0, 0, 308, 154, 155, 156, 157, 0, 0, + 0, 0, 80, 81, 81, 0, 0, 0, 81, 161, + 162, 163, 164, 165, 0, 0, 166, 0, 0, 167, + 168, 169, 0, 0, 0, 0, 0, 0, 0, 0, + 326, 82, 0, 0, 82, 0, 0, 0, 81, 0, + 0, 0, 93, 93, 93, 93, 0, 0, 82, 82, + 0, 93, 0, 82, 0, 0, 0, 93, 93, 93, + 93, 0, 0, 0, 0, 0, 0, 93, 93, 0, + 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, + 0, 0, 0, 82, 0, 143, 0, 0, 143, 0, + 0, 0, 0, 0, 0, 94, 94, 94, 94, 0, + 0, 0, 143, 143, 94, 0, 0, 143, 0, 0, + 94, 94, 94, 94, 0, 0, 0, 0, 0, 0, + 94, 94, 0, 94, 94, 94, 94, 94, 94, 94, + 0, 0, 0, 92, 92, 92, 92, 143, 0, 0, + 0, 0, 92, 0, 0, 0, 0, 0, 92, 92, + 92, 92, 142, 0, 0, 142, 0, 0, 92, 92, + 0, 92, 92, 92, 92, 92, 92, 92, 0, 142, + 142, 0, 0, 0, 142, 0, 0, 0, 0, 0, + 0, 80, 80, 80, 80, 79, 0, 0, 79, 0, + 80, 0, 0, 0, 0, 0, 80, 80, 80, 80, + 0, 0, 79, 79, 142, 131, 80, 80, 131, 80, + 80, 80, 80, 80, 80, 80, 0, 81, 81, 81, + 81, 0, 131, 131, 0, 0, 81, 131, 0, 0, + 0, 0, 81, 81, 81, 81, 0, 79, 0, 0, + 0, 0, 81, 81, 0, 81, 81, 81, 81, 81, + 81, 102, 0, 0, 102, 0, 0, 131, 0, 0, + 0, 0, 82, 82, 82, 82, 0, 0, 102, 102, + 0, 82, 0, 102, 0, 0, 0, 82, 82, 0, + 82, 170, 0, 0, 0, 0, 0, 82, 82, 0, + 82, 82, 82, 82, 82, 82, 0, 67, 0, 0, + 67, 0, 0, 102, 87, 0, 0, 87, 0, 0, + 0, 0, 0, 152, 67, 67, 143, 143, 143, 143, + 0, 87, 87, 0, 0, 143, 87, 0, 0, 0, + 0, 143, 143, 0, 0, 0, 89, 0, 0, 89, + 0, 143, 143, 0, 143, 143, 143, 143, 143, 67, + 0, 0, 0, 89, 89, 0, 87, 0, 89, 0, + 0, 159, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 86, 86, 86, 86, 0, 0, 0, 0, - 0, 86, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 86, 86, 0, 0, 86, - 86, 86, 86, 86, 153, 0, 0, 0, 154, 155, - 156, 157, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 158, 160, 161, 162, 163, 0, 164, 165, - 0, 0, 166, 0, 0, 167, 168, 169, 0, 0, - 0, 0, 0, 0, 153, 0, 0, 0, 154, 155, - 156, 157, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 158, 160, 161, 162, 163, 0, 164, 165, - 0, 0, 166, 0, 0, 167, 168, 169, 0, 154, - 155, 156, 157, 0, 0, 0, 0, 0, 0, 67, - 0, 0, 0, 81, 0, 161, 162, 163, 0, 164, - 165, 0, 0, 166, 0, 0, 167, 168, 169, 97, - 99, 101, 103, 0, 0, 0, 0, 0, 0, 113, - 0, 0, 0, 0, 0, 0, 0, 126, 0, 0, + 0, 0, 0, 142, 142, 142, 142, 0, 89, 170, + 0, 0, 142, 0, 0, 159, 0, 0, 142, 142, + 0, 0, 0, 0, 0, 0, 0, 0, 142, 142, + 0, 142, 142, 142, 142, 142, 79, 79, 79, 79, + 0, 152, 0, 170, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 131, 131, 131, 131, + 0, 79, 79, 0, 0, 131, 0, 0, 0, 0, + 0, 131, 131, 0, 0, 152, 0, 0, 0, 0, + 0, 131, 131, 0, 131, 131, 131, 131, 131, 0, + 0, 0, 0, 0, 0, 0, 0, 154, 155, 156, + 157, 0, 102, 102, 102, 102, 0, 0, 0, 0, + 0, 102, 0, 162, 163, 164, 165, 102, 102, 166, + 0, 0, 167, 168, 169, 0, 0, 102, 102, 0, + 102, 102, 102, 102, 102, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 67, 67, + 67, 67, 0, 0, 0, 87, 87, 87, 87, 0, + 0, 0, 0, 0, 87, 0, 0, 0, 0, 0, + 0, 0, 0, 67, 67, 0, 0, 0, 0, 0, + 87, 87, 0, 87, 87, 87, 87, 89, 89, 89, + 89, 0, 0, 0, 0, 0, 89, 0, 0, 153, + 0, 0, 0, 0, 0, 154, 155, 156, 157, 0, + 0, 0, 89, 89, 0, 89, 89, 89, 158, 160, + 161, 162, 163, 164, 165, 0, 0, 166, 0, 0, + 167, 168, 169, 153, 0, 0, 0, 0, 0, 154, + 155, 156, 157, 0, 0, 0, 0, 67, 0, 0, + 0, 81, 0, 160, 161, 162, 163, 164, 165, 0, + 0, 166, 0, 0, 167, 168, 169, 97, 99, 101, + 103, 0, 0, 0, 0, 0, 111, 0, 0, 120, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 179, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 187, 0, 0, 190, 0, 192, 0, 194, 0, 196, + 0, 0, 0, 0, 179, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 187, 0, + 0, 190, 0, 192, 0, 194, 0, 196, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 215, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 215, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 253, 0, 0, - 0, 0, 0, 0, 260, + 0, 0, 0, 0, 0, 253, 0, 0, 0, 0, + 0, 0, 260, }; short yycheck[] = { 13, - 36, 85, 59, 196, 40, 123, 59, 36, 93, 91, - 59, 41, 93, 91, 44, 40, 185, 41, 36, 41, - 44, 90, 59, 91, 198, 59, 41, 93, 58, 59, - 44, 257, 40, 40, 58, 59, 41, 257, 41, 44, - 91, 123, 40, 57, 59, 123, 59, 61, 41, 118, - 41, 41, 41, 58, 59, 123, 44, 41, 63, 41, - 257, 40, 278, 93, 0, 6, 91, 8, 59, 93, - 59, 40, 123, 91, 41, 125, 96, 40, 98, 59, - 100, 59, 102, 40, 104, 105, 123, 40, 93, 123, - 31, 32, 59, 41, 123, 109, 110, 33, 123, 41, - 36, 37, 38, 41, 40, 123, 42, 43, 282, 45, - 40, 59, 123, 182, 59, 123, 123, 59, 187, 276, - 277, 59, 59, 59, 44, 123, 123, 59, 64, 298, - 295, 296, 146, 147, 148, 149, 150, 151, 152, 257, - 314, 257, 316, 336, 123, 260, 339, 266, 267, 268, - 41, 270, 271, 44, 40, 91, 170, 171, 172, 173, - 174, 175, 176, 0, 40, 358, 41, 58, 59, 40, - 125, 185, 63, 91, 93, 189, 93, 191, 36, 199, - 41, 195, 125, 93, 198, 91, 296, 123, 40, 125, - 126, 205, 206, 207, 59, 41, 33, 93, 212, 36, - 37, 38, 93, 40, 257, 42, 43, 41, 45, 41, - 295, 296, 41, 40, 295, 296, 266, 267, 268, 0, - 270, 271, 59, 123, 238, 41, 240, 64, 257, 295, - 296, 309, 314, 262, 312, 313, 314, 40, 295, 296, - 258, 41, 272, 273, 274, 275, 295, 296, 272, 273, - 274, 275, 33, 337, 91, 36, 37, 38, 294, 40, - 59, 42, 43, 125, 45, 295, 296, 272, 273, 274, - 275, 295, 296, 295, 296, 299, 281, 125, 59, 293, - 285, 286, 125, 64, 298, 125, 123, 41, 125, 126, - 295, 296, 295, 296, 299, 300, 301, 302, 303, 125, - 305, 41, 295, 296, 318, 295, 296, 295, 296, 41, - 91, 295, 296, 295, 296, 295, 296, 295, 296, 41, - 256, 257, 258, 259, 260, 261, 59, 263, 264, 265, + 36, 198, 196, 36, 40, 93, 85, 41, 91, 59, + 44, 36, 93, 41, 123, 41, 44, 185, 41, 41, + 40, 91, 40, 257, 93, 59, 257, 40, 40, 40, + 58, 59, 46, 59, 41, 63, 59, 44, 93, 257, + 123, 276, 277, 57, 41, 26, 41, 61, 91, 41, + 59, 58, 59, 123, 44, 41, 63, 41, 91, 93, + 59, 59, 43, 44, 0, 93, 96, 40, 98, 50, + 100, 91, 102, 90, 104, 105, 41, 59, 40, 59, + 123, 62, 63, 64, 65, 282, 93, 266, 267, 268, + 123, 270, 271, 40, 59, 109, 110, 33, 123, 40, + 36, 37, 38, 123, 40, 123, 42, 43, 125, 45, + 123, 123, 123, 59, 123, 59, 278, 314, 123, 316, + 297, 298, 41, 59, 123, 44, 59, 40, 64, 110, + 298, 41, 146, 147, 148, 149, 150, 151, 152, 59, + 44, 6, 336, 8, 63, 339, 123, 59, 257, 59, + 41, 257, 260, 40, 40, 91, 170, 171, 172, 173, + 174, 175, 176, 0, 358, 182, 31, 32, 59, 199, + 187, 185, 91, 41, 41, 189, 40, 191, 41, 36, + 125, 195, 91, 91, 198, 125, 91, 123, 91, 125, + 126, 205, 59, 207, 208, 41, 33, 93, 212, 36, + 37, 38, 298, 40, 123, 42, 43, 257, 45, 297, + 298, 93, 40, 59, 123, 59, 297, 298, 41, 0, + 123, 41, 59, 41, 238, 258, 240, 64, 297, 298, + 41, 314, 257, 41, 123, 93, 44, 262, 272, 273, + 274, 275, 297, 298, 272, 273, 274, 275, 40, 40, + 58, 59, 33, 281, 91, 36, 37, 38, 337, 40, + 296, 42, 43, 297, 45, 272, 273, 274, 275, 297, + 298, 41, 300, 301, 281, 297, 298, 41, 59, 293, + 287, 288, 59, 64, 298, 93, 123, 125, 125, 126, + 297, 298, 125, 300, 301, 302, 303, 304, 305, 125, + 297, 298, 297, 298, 318, 297, 298, 297, 298, 125, + 91, 297, 298, 297, 298, 297, 298, 297, 298, 41, + 256, 257, 258, 259, 260, 261, 125, 263, 264, 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, 275, - 41, 355, 123, 279, 280, 126, 282, 283, 284, 41, - 295, 296, 123, 289, 290, 291, 292, 293, 294, 41, - 59, 297, 298, 295, 296, 41, 41, 59, 304, 44, - 59, 41, 308, 41, 310, 311, 295, 296, 295, 296, - 59, 272, 273, 274, 275, 295, 296, 41, 63, 13, - 281, 147, 318, 355, 285, 286, 287, 288, 195, 295, - 296, 93, 125, -1, 295, 296, -1, 95, 299, 300, - 301, 302, 303, -1, 305, 306, 91, -1, 309, 256, - 257, 258, 259, 260, 261, -1, 263, 264, 265, 266, - 267, 268, 269, 270, 271, 272, 273, 274, 275, -1, - 41, -1, 279, 280, -1, 282, 283, 284, 123, 91, - -1, -1, 289, 290, 291, 292, 293, 294, -1, -1, - 297, 298, 63, 272, 273, 274, 275, 304, -1, -1, + 41, 355, 123, 279, 280, 126, 282, 283, 284, 285, + 286, 297, 298, 297, 298, 291, 292, 293, 294, 295, + 296, 41, 281, 299, 297, 298, 41, 59, 287, 288, + 289, 290, 308, 41, 310, 311, 41, 297, 298, 123, + 289, 300, 301, 302, 303, 304, 305, 306, 41, 59, + 309, 59, 41, 312, 313, 314, 59, 306, 41, 41, + 309, 297, 298, 312, 313, 314, 309, 59, 41, 312, + 313, 314, 13, 147, 95, 297, 298, 355, 91, 256, + 257, 258, 259, 260, 261, 93, 263, 264, 265, 266, + 267, 268, 269, 270, 271, 272, 273, 274, 275, 297, + 298, 318, 279, 280, 195, 282, 283, 284, 285, 286, + 123, -1, -1, -1, 291, 292, 293, 294, 295, 296, + -1, -1, 299, 91, 272, 273, 274, 275, -1, -1, -1, 308, -1, 310, 311, 256, 257, 258, 259, 260, - 261, 123, 263, 264, 265, -1, 295, 296, 269, -1, - 91, 272, 273, 274, 275, -1, -1, -1, 279, 280, - -1, 282, 283, 284, -1, -1, -1, -1, 289, 290, - 291, 292, 293, 294, -1, -1, 297, 298, -1, -1, - -1, -1, 123, 304, 190, 91, 192, 308, 33, 310, + 261, 125, 263, 264, 265, -1, -1, -1, 269, 297, + 298, 272, 273, 274, 275, 123, -1, -1, 279, 280, + -1, 282, 283, 284, 285, 286, -1, -1, -1, 91, + 291, 292, 293, 294, 295, 296, -1, -1, 299, -1, + -1, -1, 125, -1, 91, -1, -1, 308, 33, 310, 311, 36, 37, 38, -1, 40, 41, 42, 43, 44, - 45, -1, -1, 266, 267, 268, -1, 270, 271, -1, - -1, -1, -1, 58, 59, -1, -1, 123, 63, 64, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 272, 273, 274, 275, -1, -1, 91, -1, 93, 33, + 45, 123, -1, 25, 26, 190, -1, 192, 272, 273, + 274, 275, -1, 58, 59, 37, 123, -1, 63, 64, + -1, 43, 44, 45, -1, -1, -1, -1, 50, -1, + -1, -1, -1, 297, 298, -1, -1, -1, -1, -1, + 62, 63, 64, 65, -1, -1, 91, -1, 93, 33, -1, -1, 36, 37, 38, -1, 40, 41, 42, 43, - 44, 45, -1, 295, 296, -1, 281, -1, -1, -1, - 285, 286, 287, 288, 58, 59, -1, -1, 123, 63, - 64, 126, -1, -1, 299, 300, 301, 302, 303, -1, - 305, 306, -1, -1, 309, -1, -1, 312, 313, 314, - -1, -1, -1, 285, 286, 287, 288, -1, 33, 93, - -1, 36, 37, 38, -1, 40, -1, 42, 43, -1, - 45, 303, -1, 305, 306, -1, -1, 309, 334, 335, - 312, 313, 314, -1, 59, 341, -1, -1, -1, 64, - 281, -1, 126, -1, 285, 286, 287, 288, -1, -1, - 356, -1, -1, 359, -1, -1, -1, -1, 299, 300, - 301, 302, 303, -1, 305, 306, 91, -1, 309, -1, - -1, 312, 313, 314, 41, -1, -1, 44, -1, 285, - 286, 287, 288, -1, -1, -1, -1, -1, -1, -1, - -1, 58, 59, -1, -1, -1, 63, -1, 123, 305, - 306, 126, -1, 309, -1, -1, 312, 313, 314, -1, - -1, -1, 257, 258, 259, 260, 261, -1, 263, 264, - 265, -1, -1, -1, 269, -1, 93, 272, 273, 274, + 44, 45, -1, -1, 272, 273, 274, 275, -1, -1, + -1, -1, -1, -1, 58, 59, 289, 290, 123, 63, + 64, 126, 266, 267, 268, -1, 270, 271, 110, 297, + 298, -1, 305, 306, -1, -1, 309, -1, -1, 312, + 313, 314, -1, -1, -1, -1, -1, -1, 33, 93, + -1, 36, 37, 38, -1, 40, -1, 42, 43, 287, + 45, 289, 290, 266, 267, 268, -1, 270, 271, -1, + -1, -1, -1, -1, 59, -1, -1, 305, 306, 64, + -1, 309, 126, -1, 312, 313, 314, 169, -1, 334, + 335, -1, -1, -1, -1, -1, 341, -1, -1, 41, + -1, -1, 44, -1, -1, -1, 91, 289, 290, -1, + -1, 356, -1, -1, 359, 197, 58, 59, -1, -1, + -1, 63, -1, -1, 306, -1, -1, 309, -1, -1, + 312, 313, 314, -1, -1, -1, -1, -1, 123, 306, + -1, 126, 309, -1, -1, 312, 313, 314, -1, -1, + -1, 93, 257, 258, 259, 260, 261, -1, 263, 264, + 265, -1, -1, -1, 269, -1, -1, 272, 273, 274, 275, -1, -1, -1, -1, 280, 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, @@ -718,362 +709,352 @@ short yycheck[] = { 13, 294, 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, -1, 308, 309, 310, 311, 312, 313, 314, 256, 257, 258, 259, 260, 261, -1, 263, 264, - 265, -1, -1, 41, 269, -1, 44, 272, 273, 274, + 265, -1, -1, -1, 269, -1, -1, 272, 273, 274, 275, -1, -1, -1, 279, 280, -1, 282, 283, 284, - 58, 59, -1, -1, 289, 290, 291, 292, 293, 294, - -1, -1, 297, 298, -1, -1, -1, -1, -1, 304, - -1, -1, -1, 308, 33, 310, 311, 36, 37, 38, - -1, 40, -1, 42, 43, 93, 45, -1, -1, -1, - -1, -1, -1, -1, -1, 272, 273, 274, 275, -1, - 59, -1, -1, -1, 281, 64, -1, -1, 285, 286, - 287, 288, -1, -1, -1, -1, -1, -1, 295, 296, - -1, -1, 299, 300, 301, 302, 303, -1, 305, 306, - 33, -1, 91, 36, 37, 38, -1, 40, -1, 42, - 43, 26, 45, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 49, 50, -1, -1, 42, -1, -1, - -1, 64, -1, 48, 123, 50, -1, 126, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 62, 63, 64, - 65, 91, -1, -1, -1, -1, 33, -1, 91, 36, - 37, 38, -1, 40, 90, 42, 43, -1, 45, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 123, -1, -1, -1, 64, -1, -1, - 123, -1, 118, 126, -1, 110, 309, 310, 311, 125, - -1, -1, 315, -1, 317, -1, -1, 41, -1, -1, - 44, -1, -1, -1, 91, -1, -1, -1, -1, 33, - -1, -1, 36, 37, 38, 59, 40, -1, 42, 43, - 343, 45, -1, -1, 272, 273, 274, 275, 351, -1, - 353, 91, -1, -1, -1, 59, 123, -1, -1, 126, - 64, 364, -1, -1, -1, -1, 182, 295, 296, 93, - -1, 187, -1, -1, -1, -1, -1, 256, 257, 258, - 259, 260, 261, 123, 263, 264, 265, 91, -1, -1, - 269, -1, -1, 272, 273, 274, 275, -1, -1, 41, - 279, 280, 44, 282, 283, 284, -1, -1, -1, -1, - 289, 290, 291, 292, 293, 294, 58, 59, 297, 298, - -1, 63, 126, -1, -1, 304, -1, -1, -1, 308, - -1, 310, 311, -1, 257, 258, 259, 260, 261, 262, - 263, 264, 265, -1, -1, -1, 269, 41, -1, -1, - 44, 93, -1, -1, -1, 41, -1, 280, 44, 282, - 283, 284, -1, -1, 58, 59, 289, 290, 291, 292, - 293, 294, 58, 59, 297, 298, 306, 63, -1, 309, - -1, 304, 312, 313, 314, 308, -1, 310, 311, -1, - 257, 258, 259, 260, 261, -1, 263, 264, 265, 93, - -1, -1, 269, -1, -1, -1, -1, 93, -1, -1, - 91, 41, -1, 280, 44, 282, 283, 284, -1, -1, - -1, -1, 289, 290, 291, 292, 293, 294, 58, 59, - 297, 298, -1, 63, -1, -1, -1, 304, -1, -1, - -1, 308, 123, 310, 311, -1, -1, 287, 272, 273, - 274, 275, -1, 257, 258, 259, 260, 261, -1, 263, - 264, 265, -1, 93, 41, 269, 306, 44, -1, 309, - -1, 295, 312, 313, 314, -1, 280, -1, 282, 283, - 284, 58, 59, -1, -1, 289, 290, 291, 292, 293, - 294, -1, -1, 297, 298, -1, -1, -1, -1, -1, - 304, -1, -1, -1, 308, 33, 310, 311, 36, 37, - 38, -1, 40, -1, 42, 43, 93, 45, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 272, 273, 274, 275, -1, -1, 64, -1, -1, 281, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 295, 296, -1, -1, 299, 300, 301, - 302, 33, -1, 91, 36, 37, 38, -1, 40, 41, - 42, 43, -1, 45, -1, -1, -1, -1, 272, 273, - 274, 275, -1, -1, -1, -1, 272, 273, 274, 275, - -1, -1, 64, -1, -1, 123, -1, -1, 126, -1, - -1, 295, 296, -1, -1, -1, 287, 288, -1, 295, - 296, -1, -1, 299, -1, -1, -1, 33, -1, 91, - 36, 37, 38, -1, 40, 306, 42, 43, 309, 45, - -1, 312, 313, 314, -1, -1, -1, -1, -1, -1, - -1, -1, 272, 273, 274, 275, -1, -1, 64, -1, - -1, 281, -1, -1, 126, 285, 286, -1, -1, -1, - -1, -1, -1, -1, -1, 295, 296, -1, -1, 299, - 300, 301, 302, 303, -1, 91, -1, 93, -1, -1, - 33, -1, -1, 36, 37, 38, -1, 40, 41, 42, - 43, -1, 45, -1, -1, 272, 273, 274, 275, -1, + 285, 286, -1, -1, -1, 91, 291, 292, 293, 294, + 295, 296, 33, -1, 299, 36, 37, 38, -1, 40, + -1, 42, 43, 308, 45, 310, 311, 43, -1, -1, + 272, 273, 274, 275, -1, 51, -1, 123, 59, 281, + -1, -1, -1, 64, -1, 287, 288, 289, 290, -1, + -1, -1, -1, -1, -1, 297, 298, -1, 300, 301, + 302, 303, 304, 305, 306, -1, -1, 309, 33, -1, + 91, 36, 37, 38, 90, 40, -1, 42, 43, -1, + 45, -1, -1, -1, -1, -1, -1, -1, 309, 310, + 311, -1, -1, -1, 315, -1, 317, -1, -1, 64, + -1, 117, 123, -1, -1, 126, -1, -1, -1, 125, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 126, 64, -1, -1, -1, -1, -1, -1, 295, 296, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 257, - 258, 259, 260, 261, -1, 263, 264, 265, 91, -1, - -1, 269, 41, -1, -1, 44, -1, -1, -1, -1, - 41, -1, 280, 44, 282, 283, 284, -1, -1, 58, - 59, 289, 290, 291, 292, 293, 294, 58, 59, 297, - 298, -1, 63, 126, -1, -1, 304, -1, -1, -1, - 308, -1, 310, 311, -1, 257, 258, 259, 260, 261, - -1, 263, 264, 265, 93, -1, -1, 269, -1, -1, - -1, -1, 93, -1, -1, -1, 41, -1, 280, 44, - 282, 283, 284, -1, -1, -1, -1, 289, 290, 291, - 292, 293, 294, 58, 59, 297, 298, -1, 63, -1, - -1, -1, 304, -1, -1, -1, 308, -1, 310, 311, - -1, 257, 258, 259, 260, 261, -1, 263, 264, 265, - -1, -1, -1, 269, -1, -1, -1, -1, 93, -1, - -1, -1, 41, -1, 280, 44, 282, 283, 284, -1, - -1, -1, -1, 289, 290, 291, 292, 293, 294, 58, - 59, 297, 298, -1, 63, -1, -1, -1, 304, -1, - -1, -1, 308, -1, 310, 311, -1, -1, -1, -1, - -1, -1, -1, -1, 257, 258, 259, 260, 261, -1, - 263, 264, 265, -1, 93, -1, 269, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 63, 280, -1, 282, - 283, 284, -1, -1, -1, -1, 289, 290, 291, 292, - 293, 294, -1, -1, 297, 298, -1, -1, -1, -1, - -1, 304, -1, -1, 91, 308, 33, 310, 311, 36, - 37, 38, -1, 40, 41, 42, 43, -1, 45, -1, - -1, -1, -1, 272, 273, 274, 275, -1, -1, -1, - -1, 272, 273, 274, 275, -1, 123, 64, -1, -1, - 281, -1, -1, -1, -1, -1, 295, 296, -1, -1, - -1, -1, -1, -1, 295, 296, -1, -1, 299, 300, - 301, -1, 33, -1, 91, 36, 37, 38, -1, 40, - -1, 42, 43, -1, 45, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 272, 273, 274, - 275, -1, -1, 64, -1, -1, 281, -1, -1, 126, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 295, 296, -1, -1, 299, 300, -1, -1, 33, -1, - 91, 36, 37, 38, -1, 40, 41, 42, 43, -1, - 45, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 272, 273, 274, 275, -1, -1, 64, - -1, -1, 281, -1, -1, 126, 285, 286, -1, -1, - -1, -1, -1, -1, -1, -1, 295, 296, -1, -1, - 299, 300, 301, 302, 303, -1, 91, -1, -1, -1, - -1, 33, -1, -1, 36, 37, 38, -1, 40, 41, - 42, 43, -1, 45, 281, -1, -1, -1, 285, 286, - 287, 288, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 126, 64, 300, 301, 302, 303, -1, 305, 306, + -1, -1, 343, -1, 33, -1, 91, 36, 37, 38, + 351, 40, 353, 42, 43, -1, 45, -1, -1, -1, + -1, -1, -1, 364, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 64, -1, -1, 123, -1, + -1, 126, -1, -1, -1, -1, 182, -1, -1, -1, + -1, 187, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 91, -1, -1, -1, -1, 33, -1, -1, + 36, 37, 38, -1, 40, -1, 42, 43, -1, 45, + -1, 287, 288, 289, 290, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 123, -1, -1, 126, 64, 305, + 306, -1, -1, 309, -1, -1, 312, 313, 314, -1, + -1, -1, -1, -1, -1, 256, 257, 258, 259, 260, + 261, -1, 263, 264, 265, 91, -1, -1, 269, -1, + -1, 272, 273, 274, 275, -1, -1, -1, 279, 280, + -1, 282, 283, 284, 285, 286, -1, -1, -1, -1, + 291, 292, 293, 294, 295, 296, -1, 123, 299, -1, + 126, -1, 91, -1, -1, -1, 41, 308, -1, 310, + 311, -1, 257, 258, 259, 260, 261, 262, 263, 264, + 265, -1, -1, -1, 269, -1, -1, -1, 63, -1, + -1, -1, -1, -1, 123, 280, -1, 282, 283, 284, + 285, 286, -1, -1, -1, -1, 291, 292, 293, 294, + 295, 296, -1, -1, 299, -1, 91, -1, -1, -1, + -1, -1, -1, 308, -1, 310, 311, -1, 257, 258, + 259, 260, 261, -1, 263, 264, 265, -1, -1, -1, + 269, 58, -1, -1, -1, -1, 63, -1, 123, -1, + -1, 280, -1, 282, 283, 284, 285, 286, -1, -1, + -1, -1, 291, 292, 293, 294, 295, 296, -1, -1, + 299, -1, -1, -1, 91, -1, -1, -1, -1, 308, + -1, 310, 311, -1, -1, -1, -1, 41, -1, -1, + 44, 257, 258, 259, 260, 261, -1, 263, 264, 265, + -1, -1, -1, 269, 58, 59, 123, -1, -1, 63, + -1, -1, -1, -1, 280, -1, 282, 283, 284, 285, + 286, -1, -1, -1, -1, 291, 292, 293, 294, 295, + 296, 33, -1, 299, 36, 37, 38, -1, 40, 93, + 42, 43, 308, 45, 310, 311, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 59, 287, 288, + 289, 290, 64, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 301, 302, 303, 304, 305, 306, -1, -1, + 309, -1, -1, 312, 313, 314, -1, 33, -1, 91, + 36, 37, 38, -1, 40, 41, 42, 43, -1, 45, + -1, -1, -1, -1, -1, -1, 281, -1, -1, -1, + -1, -1, 287, 288, 289, 290, -1, -1, 64, -1, + -1, -1, -1, -1, 126, 300, 301, 302, 303, 304, + 305, 306, -1, -1, 309, -1, -1, 312, 313, 314, + -1, -1, -1, 33, -1, 91, 36, 37, 38, -1, + 40, -1, 42, 43, -1, 45, -1, -1, -1, -1, + -1, -1, -1, -1, 281, -1, -1, -1, -1, -1, + 287, 288, 289, 290, 64, -1, -1, -1, -1, -1, + 126, -1, -1, 300, 301, 302, 303, 304, 305, 306, -1, -1, 309, -1, -1, 312, 313, 314, -1, -1, + -1, 91, 33, 93, -1, 36, 37, 38, -1, 40, + 41, 42, 43, -1, 45, -1, -1, -1, 272, 273, + 274, 275, -1, -1, -1, -1, -1, 281, -1, -1, + -1, -1, -1, 64, 288, -1, 126, -1, -1, -1, + -1, -1, -1, 297, 298, -1, 300, 301, 302, 303, + 304, 41, -1, -1, 44, 257, 258, 259, 260, 261, + 91, 263, 264, 265, -1, -1, -1, 269, 58, 59, + -1, -1, -1, 63, -1, -1, -1, -1, 280, -1, + 282, 283, 284, 285, 286, -1, -1, -1, -1, 291, + 292, 293, 294, 295, 296, 126, -1, 299, -1, -1, + -1, -1, -1, 93, -1, -1, 308, 41, 310, 311, + 44, 257, 258, 259, 260, 261, -1, 263, 264, 265, + -1, -1, -1, 269, 58, 59, -1, -1, -1, 63, + -1, -1, -1, -1, 280, -1, 282, 283, 284, 285, + 286, -1, -1, -1, -1, 291, 292, 293, 294, 295, + 296, -1, -1, 299, -1, -1, -1, -1, -1, 93, + -1, -1, 308, -1, 310, 311, -1, 257, 258, 259, + 260, 261, -1, 263, 264, 265, -1, 33, -1, 269, + 36, 37, 38, -1, 40, 41, 42, 43, -1, 45, + 280, -1, 282, 283, 284, 285, 286, -1, -1, -1, + -1, 291, 292, 293, 294, 295, 296, -1, 64, 299, + -1, -1, -1, -1, -1, -1, -1, -1, 308, -1, + 310, 311, -1, -1, -1, -1, 257, 258, 259, 260, + 261, -1, 263, 264, 265, 91, 33, -1, 269, 36, + 37, 38, -1, 40, -1, 42, 43, -1, 45, 280, + -1, 282, 283, 284, 285, 286, -1, -1, -1, -1, + 291, 292, 293, 294, 295, 296, -1, 64, 299, -1, + 126, -1, -1, -1, -1, -1, -1, 308, -1, 310, + 311, -1, 272, 273, 274, 275, -1, -1, -1, -1, + -1, 281, 33, -1, 91, 36, 37, 38, -1, 40, + 41, 42, 43, -1, 45, -1, -1, 297, 298, -1, + 300, 301, 302, 303, 304, -1, -1, -1, -1, -1, + -1, -1, -1, 64, -1, -1, -1, -1, -1, 126, + -1, -1, -1, -1, -1, -1, -1, -1, 272, 273, + 274, 275, -1, -1, -1, -1, -1, 281, 33, -1, + 91, 36, 37, 38, -1, 40, 41, 42, 43, -1, + 45, -1, -1, 297, 298, -1, 300, 301, 302, 303, + 304, -1, -1, -1, -1, -1, -1, -1, -1, 64, + -1, -1, -1, -1, -1, 126, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 257, 258, 259, 260, 261, 91, 263, 264, 265, + -1, 33, -1, 269, 36, 37, 38, -1, 40, -1, + 42, 43, -1, 45, 280, -1, 282, 283, 284, 285, + 286, -1, -1, -1, -1, 291, 292, 293, 294, 295, + 296, 126, 64, 299, -1, -1, -1, -1, -1, -1, + -1, -1, 308, -1, 310, 311, -1, -1, -1, 256, 257, 258, 259, 260, 261, -1, 263, 264, 265, 91, - -1, -1, 269, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 280, -1, 282, 283, 284, 41, -1, - -1, 44, 289, 290, 291, 292, 293, 294, -1, -1, - 297, 298, -1, -1, 126, 58, 59, 304, -1, -1, - 63, 308, -1, 310, 311, 256, 257, 258, 259, 260, - 261, -1, 263, 264, 265, -1, -1, -1, 269, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 280, - 93, 282, 283, 284, -1, -1, -1, -1, 289, 290, - 291, 292, 293, 294, -1, -1, 297, 298, -1, -1, - -1, -1, -1, 304, -1, -1, -1, 308, 41, 310, + -1, -1, 269, 41, -1, -1, 44, -1, -1, -1, + -1, -1, -1, 280, -1, 282, 283, 284, 285, 286, + 58, 59, -1, -1, 291, 292, 293, 294, 295, 296, + -1, -1, 299, -1, 126, -1, -1, -1, -1, 41, + -1, 308, 44, 310, 311, -1, 257, 258, 259, 260, + 261, -1, 263, 264, 265, 93, 58, 59, 269, -1, + -1, 63, -1, -1, -1, -1, -1, -1, -1, 280, + -1, 282, 283, 284, 285, 286, -1, -1, -1, -1, + 291, 292, 293, 294, 295, 296, -1, -1, 299, 91, + -1, 93, -1, -1, -1, -1, -1, 308, 41, 310, 311, 44, 257, 258, 259, 260, 261, -1, 263, 264, 265, -1, -1, -1, 269, 58, 59, -1, -1, -1, - 63, -1, -1, -1, -1, 280, -1, 282, 283, 284, - -1, -1, -1, -1, 289, 290, 291, 292, 293, 294, - -1, -1, 297, 298, -1, -1, -1, -1, 91, 304, - 93, -1, -1, 308, -1, 310, 311, 41, -1, -1, - 44, -1, -1, -1, -1, 257, 258, 259, 260, 261, - -1, 263, 264, 265, 58, 59, -1, 269, -1, 63, - 123, -1, -1, -1, -1, -1, -1, -1, 280, -1, - 282, 283, 284, -1, -1, -1, -1, 289, 290, 291, - 292, 293, 294, -1, -1, 297, 298, 91, -1, 93, - -1, -1, 304, -1, -1, -1, 308, 33, 310, 311, - 36, 37, 38, -1, 40, -1, 42, 43, -1, 45, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 123, - -1, -1, -1, -1, -1, -1, -1, -1, 64, 272, - 273, 274, 275, -1, -1, -1, -1, -1, 281, -1, - -1, -1, 285, 286, -1, 41, -1, -1, 44, -1, - -1, -1, 295, 296, -1, 91, 299, 300, 301, 302, - 303, -1, 58, 59, -1, -1, -1, 63, 25, 26, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 37, -1, -1, -1, -1, 42, 43, -1, -1, -1, - 126, 48, -1, 50, -1, 91, -1, 93, -1, -1, - -1, -1, -1, -1, -1, 62, 63, 64, 65, 272, - 273, 274, 275, 41, -1, 91, 44, -1, 281, -1, - -1, -1, 285, 286, 287, 288, -1, 123, -1, -1, - 58, 59, 295, 296, -1, 63, 299, 300, 301, 302, - 303, -1, 305, 306, -1, -1, 309, 123, -1, 312, - 313, 314, -1, 110, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 91, -1, 93, -1, -1, 272, 273, - 274, 275, -1, -1, -1, -1, -1, 281, -1, -1, - -1, 285, 286, 287, 288, -1, -1, -1, -1, -1, - -1, 295, 296, -1, 91, 299, 300, 301, 302, 303, - -1, 305, 306, -1, -1, 309, -1, -1, 312, 313, - 314, -1, 169, 41, -1, -1, 44, -1, -1, -1, - -1, 257, 258, 259, 260, 261, 123, 263, 264, 265, - 58, 59, -1, 269, -1, 63, -1, -1, -1, -1, - 197, -1, -1, -1, 280, -1, 282, 283, 284, -1, - -1, -1, -1, 289, 290, 291, 292, 293, 294, -1, - -1, 297, 298, -1, -1, 93, -1, -1, 304, -1, - -1, -1, 308, -1, 310, 311, 272, 273, 274, 275, - 41, -1, -1, 44, -1, 281, -1, -1, -1, 285, - 286, 287, 288, -1, -1, 123, -1, 58, 59, 295, - 296, -1, 63, 299, 300, 301, 302, 303, -1, 305, - 306, 287, 288, 309, -1, -1, 312, 313, 314, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 305, - 306, -1, 93, 309, -1, -1, 312, 313, 314, -1, - -1, -1, -1, -1, 272, 273, 274, 275, 41, -1, - -1, -1, -1, 281, -1, -1, -1, 285, 286, 287, - 288, -1, 123, -1, -1, 58, 59, 295, 296, -1, - 63, 299, 300, 301, 302, 303, -1, 305, 306, -1, - -1, 309, -1, -1, 312, 313, 314, -1, 285, 286, - 287, 288, -1, -1, -1, -1, -1, -1, 91, -1, - 93, -1, -1, 300, 301, 302, 303, -1, 305, 306, - -1, 41, 309, -1, -1, 312, 313, 314, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 58, 59, - 123, -1, -1, 63, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 272, 273, 274, 275, -1, -1, - -1, -1, -1, 281, -1, -1, -1, 285, 286, 287, - 288, 91, -1, 93, -1, -1, -1, 295, 296, -1, - -1, 299, 300, 301, 302, 303, -1, 305, 306, 41, - -1, 309, 44, -1, 312, 313, 314, -1, -1, -1, - -1, -1, -1, 123, -1, -1, 58, 59, -1, -1, - -1, 63, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 272, 273, 274, 275, -1, -1, -1, -1, -1, - 281, -1, -1, -1, 285, 286, 287, 288, -1, -1, - -1, 93, -1, -1, 295, 296, -1, -1, 299, 300, - 301, 302, 303, -1, 305, 306, 41, -1, 309, 44, - -1, 312, 313, 314, -1, -1, -1, -1, -1, -1, - -1, 123, -1, 58, 59, -1, -1, -1, 63, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 272, - 273, 274, 275, -1, -1, -1, -1, -1, 281, -1, - -1, -1, 285, 286, 287, 288, -1, -1, 93, -1, - -1, -1, 295, 296, -1, -1, 299, 300, 301, 302, - 303, -1, 305, 306, -1, -1, 309, -1, -1, 312, - 313, 314, -1, -1, -1, -1, -1, -1, 123, 91, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 272, 273, 274, 275, 41, -1, -1, -1, - -1, 281, -1, -1, -1, 285, 286, 287, 288, -1, - -1, 123, -1, 58, 59, 295, 296, -1, 63, 299, - 300, 301, 302, 303, -1, 305, 306, -1, -1, 309, - -1, -1, 312, 313, 314, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 91, -1, 93, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 272, 273, 274, 275, 41, -1, -1, 44, -1, 281, - -1, -1, -1, 285, 286, 287, 288, -1, 123, -1, - -1, 58, 59, 295, 296, -1, 63, 299, 300, 301, - 302, 303, -1, 305, 306, -1, -1, 309, -1, -1, + 63, 123, -1, -1, -1, 280, -1, 282, 283, 284, + 285, 286, -1, -1, -1, -1, 291, 292, 293, 294, + 295, 296, -1, -1, 299, -1, -1, -1, 91, -1, + 93, -1, -1, 308, -1, 310, 311, -1, -1, -1, + -1, 41, -1, -1, 44, 257, 258, 259, 260, 261, + -1, 263, 264, 265, -1, -1, -1, 269, 58, 59, + 123, -1, -1, 63, -1, -1, -1, -1, 280, -1, + 282, 283, 284, 285, 286, -1, -1, -1, -1, 291, + 292, 293, 294, 295, 296, -1, -1, 299, -1, 41, + -1, 91, 44, 93, -1, -1, 308, -1, 310, 311, + -1, -1, -1, -1, -1, -1, 58, 59, -1, -1, + -1, 63, -1, -1, 272, 273, 274, 275, -1, -1, + -1, -1, -1, 123, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 297, + 298, 93, 300, -1, -1, -1, -1, -1, -1, -1, + 272, 273, 274, 275, -1, 41, -1, -1, 44, 281, + -1, -1, -1, -1, -1, 287, 288, 289, 290, -1, + -1, 123, 58, 59, -1, 297, 298, 63, 300, 301, + 302, 303, 304, 305, 306, -1, -1, 309, -1, -1, 312, 313, 314, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 91, -1, 93, -1, 272, + 273, 274, 275, -1, 41, -1, -1, 44, 281, -1, + -1, -1, -1, -1, 287, 288, 289, 290, -1, -1, + -1, 58, 59, -1, 297, 298, 63, 300, 301, 302, + 303, 304, 305, 306, -1, -1, 309, -1, -1, 312, + 313, 314, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 93, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 272, 273, 274, - 275, 41, -1, -1, 44, -1, 281, -1, -1, -1, - 285, 286, 287, 288, -1, -1, 123, -1, 58, 59, - 295, 296, -1, 63, 299, 300, 301, 302, 303, -1, - 305, 306, -1, -1, 309, -1, -1, 312, 313, 314, - -1, -1, -1, 285, 41, 287, 288, 44, -1, -1, - -1, -1, -1, 93, -1, -1, -1, -1, -1, -1, - -1, 58, 59, 305, 306, -1, 63, 309, -1, -1, + -1, -1, 272, 273, 274, 275, -1, -1, -1, -1, + -1, 281, -1, -1, -1, -1, -1, 287, 288, 289, + 290, -1, -1, -1, -1, -1, 123, 297, 298, -1, + 300, 301, 302, 303, 304, 305, 306, -1, -1, 309, + -1, -1, 312, 313, 314, -1, -1, -1, -1, -1, + 272, 273, 274, 275, -1, 41, -1, -1, -1, 281, + -1, -1, -1, -1, -1, 287, 288, 289, 290, -1, + -1, -1, 58, 59, -1, 297, 298, 63, 300, 301, + 302, 303, 304, 305, 306, -1, -1, 309, -1, -1, 312, 313, 314, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 91, -1, 93, -1, -1, + -1, -1, -1, -1, -1, -1, 272, 273, 274, 275, + -1, -1, -1, -1, -1, 281, -1, -1, -1, -1, + -1, 287, 288, 289, 290, -1, -1, 123, -1, -1, + 91, 297, 298, -1, 300, 301, 302, 303, 304, 305, + 306, -1, -1, 309, -1, -1, 312, 313, 314, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 93, 272, 273, 274, - 275, 41, -1, -1, 44, -1, 281, -1, -1, -1, - 285, 286, 287, 288, -1, -1, -1, -1, 58, 59, - 295, 296, -1, 63, 299, 300, 301, 302, 303, -1, - 305, 306, -1, -1, 309, -1, -1, 312, 313, 314, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 93, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 272, 273, 274, 275, 41, - -1, -1, 44, -1, 281, -1, -1, -1, 285, 286, - 287, 288, -1, -1, -1, -1, 58, 59, 295, 296, - -1, 63, 299, 300, 301, 302, 303, -1, 305, 306, + -1, -1, 123, -1, -1, 272, 273, 274, 275, -1, + 41, -1, -1, -1, 281, -1, -1, -1, -1, -1, + 287, 288, 289, 290, -1, -1, -1, 58, 59, -1, + 297, 298, 63, 300, 301, 302, 303, 304, 305, 306, -1, -1, 309, -1, -1, 312, 313, 314, -1, -1, + -1, -1, -1, 41, -1, -1, 44, -1, -1, -1, + 91, -1, 93, 41, -1, -1, 44, -1, -1, -1, + 58, 59, -1, -1, -1, 63, -1, -1, -1, -1, + 58, 59, -1, -1, -1, 63, -1, -1, -1, -1, + -1, -1, 123, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 93, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 93, 272, 273, 274, 275, + -1, 41, -1, -1, 44, 281, -1, -1, -1, -1, + -1, 287, 288, 289, 290, 123, -1, -1, 58, 59, + -1, 297, 298, 63, 300, 301, 302, 303, 304, 305, + 306, -1, -1, 309, -1, -1, 312, 313, 314, -1, + -1, -1, -1, -1, 41, -1, 287, 288, 289, 290, + -1, -1, -1, 93, -1, -1, -1, -1, -1, -1, + -1, 58, 59, 304, 305, 306, 63, -1, 309, -1, + -1, 312, 313, 314, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 123, -1, -1, -1, -1, 41, -1, + -1, 44, -1, -1, 91, -1, 93, -1, -1, -1, + -1, -1, -1, -1, -1, 58, 59, -1, -1, -1, + 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 272, 273, 274, 275, -1, 123, -1, -1, -1, + 281, -1, -1, -1, -1, -1, 287, 288, 289, 290, + 93, -1, -1, -1, -1, -1, 297, 298, -1, 300, + 301, 302, 303, 304, 305, 306, -1, -1, 309, -1, + -1, 312, 313, 314, 272, 273, 274, 275, -1, 41, + 123, -1, 44, 281, 272, 273, 274, 275, -1, 287, + 288, 289, 290, -1, -1, -1, 58, 59, -1, 297, + 298, 63, 300, 301, 302, 303, 304, 305, 306, 297, + 298, 309, 300, -1, 312, 313, 314, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 93, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 272, 273, 274, 275, -1, -1, -1, -1, - -1, 281, -1, -1, -1, 285, 286, 287, 288, -1, - -1, -1, -1, -1, -1, 295, 296, -1, -1, 299, - 300, 301, 302, 303, -1, 305, 306, -1, -1, 309, - -1, -1, 312, 313, 314, 272, 273, 274, 275, 41, - -1, -1, 44, -1, 281, -1, -1, -1, 285, 286, - 287, 288, -1, -1, -1, -1, 58, 59, 295, 296, - -1, 63, 299, 300, 301, 302, 303, -1, 305, 306, - -1, -1, 309, -1, -1, 312, 313, 314, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 93, 272, 273, 274, 275, -1, -1, -1, -1, - -1, 281, -1, -1, -1, 285, 286, 287, 288, -1, - -1, -1, -1, -1, -1, 295, 296, -1, -1, 299, - 300, 301, 302, 303, -1, 305, 306, 41, -1, 309, - 44, -1, 312, 313, 314, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 58, 59, -1, -1, -1, 63, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 272, 273, 274, 275, -1, -1, -1, -1, -1, 281, - -1, -1, -1, 285, 286, 287, 288, -1, -1, 93, - -1, -1, -1, 295, 296, -1, -1, 299, 300, 301, - 302, 303, -1, 305, 306, 30, -1, 309, -1, -1, - 312, 313, 314, 38, -1, -1, -1, -1, 43, -1, - 41, -1, -1, 44, -1, -1, 51, 52, 53, 54, - 55, 56, -1, -1, 59, 60, -1, 58, 59, -1, - -1, 66, 63, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 92, 41, -1, - -1, 44, 93, -1, -1, -1, -1, -1, -1, -1, - 272, 273, 274, 275, -1, 58, 59, -1, -1, 281, - 63, -1, -1, 285, 286, 287, 288, -1, -1, -1, - -1, -1, -1, 295, 296, -1, -1, 299, 300, 301, - 302, 303, -1, 305, 306, -1, -1, 309, -1, -1, - 93, -1, -1, -1, -1, -1, -1, -1, 153, 154, + -1, -1, 272, 273, 274, 275, -1, 41, -1, -1, + 44, 281, -1, -1, -1, -1, -1, 287, 288, 289, + 290, -1, -1, -1, 58, 59, -1, 297, 298, 63, + 300, 301, 302, 303, 304, 305, 306, -1, -1, 309, + -1, -1, 312, 313, 314, 272, 273, 274, 275, -1, + 41, -1, -1, 44, 281, -1, -1, -1, -1, 93, + 287, 288, 289, 290, -1, -1, -1, 58, 59, -1, + 297, 298, 63, 300, 301, 302, 303, 304, 305, 306, + -1, -1, 309, -1, -1, 312, 313, 314, -1, 272, + 273, 274, 275, -1, 41, -1, -1, 44, 281, -1, + -1, -1, 93, -1, 287, 288, 289, 290, -1, -1, + -1, 58, 59, -1, 297, 298, 63, 300, 301, 302, + 303, 304, 305, 306, -1, -1, 309, -1, -1, 312, + 313, 314, -1, -1, -1, -1, -1, 41, -1, -1, + 44, -1, -1, -1, -1, -1, 93, -1, -1, -1, + -1, -1, -1, -1, 58, 59, -1, 41, -1, 63, + 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 272, 273, 274, 275, 58, 59, -1, -1, -1, 281, + -1, -1, -1, -1, -1, 287, 288, 289, 290, 93, + -1, -1, -1, -1, -1, 297, 298, -1, 300, 301, + 302, 303, 304, 305, 306, 41, -1, 309, 44, 93, + 312, 313, 314, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 58, 59, -1, -1, -1, 63, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 272, 273, + 274, 275, -1, 41, -1, -1, 44, 281, -1, -1, + -1, -1, -1, 287, 288, 289, 290, 93, -1, -1, + 58, 59, -1, 297, 298, 63, 300, 301, 302, 303, + 304, 305, 306, -1, -1, 309, -1, -1, 312, 313, + 314, 272, 273, 274, 275, -1, -1, -1, -1, -1, + 281, -1, -1, -1, -1, 93, 287, 288, 289, 290, + -1, -1, -1, -1, -1, -1, 297, 298, -1, 300, + 301, 302, 303, 304, 305, 306, -1, -1, 309, -1, + -1, 312, 313, 314, -1, 272, 273, 274, 275, -1, + 41, -1, -1, 44, 281, -1, -1, -1, -1, -1, + 287, 288, 289, 290, -1, -1, -1, 58, 59, -1, + 297, 298, 63, 300, 301, 302, 303, 304, 305, 306, + -1, -1, 309, -1, -1, 312, 313, 314, 272, 273, + 274, 275, -1, -1, -1, -1, -1, 281, -1, -1, + -1, -1, 93, 287, 288, 289, 290, -1, 272, 273, + 274, 275, -1, 297, 298, 30, 300, 301, 302, 303, + 304, 305, 306, 38, -1, 309, -1, 42, -1, -1, + 45, -1, -1, 297, 298, -1, -1, 52, 53, 54, + 55, 56, -1, -1, 59, 60, -1, -1, 91, -1, + -1, 66, -1, -1, -1, -1, 272, 273, 274, 275, + -1, 41, -1, -1, 44, 281, -1, -1, -1, -1, + -1, 287, 288, 289, 290, -1, -1, 92, 58, 59, + 123, 297, 298, 63, 300, 301, 302, 303, 304, 305, + 306, -1, -1, -1, 272, 273, 274, 275, -1, -1, + -1, -1, -1, 281, -1, -1, -1, -1, -1, 287, + 288, 289, 290, 93, 41, -1, -1, 44, -1, 297, + 298, -1, 300, 301, 302, 303, 304, 305, 306, -1, + -1, 58, 59, -1, -1, -1, 63, -1, 153, 154, 155, 156, 157, 158, 159, 160, 161, 162, 163, 164, 165, 166, 41, -1, -1, 44, -1, -1, -1, -1, - -1, -1, -1, 178, -1, -1, -1, -1, -1, 58, - 59, -1, -1, -1, 63, -1, -1, -1, 272, 273, - 274, 275, -1, -1, -1, -1, -1, 281, -1, -1, - -1, 285, 286, 287, 288, -1, 41, -1, -1, 44, - -1, 295, 296, -1, 93, 299, 300, 301, 302, 303, - -1, 305, 306, 58, 59, -1, -1, -1, 63, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 41, -1, -1, 44, -1, -1, - -1, -1, -1, 258, -1, -1, -1, -1, 93, -1, - -1, 58, 59, -1, -1, -1, 63, -1, -1, -1, + -1, -1, -1, 178, -1, -1, 93, -1, -1, 58, + 59, -1, -1, -1, 63, -1, -1, -1, -1, -1, -1, 272, 273, 274, 275, -1, -1, -1, -1, -1, - 281, -1, -1, -1, 285, 286, 287, 288, -1, 41, - 295, -1, 44, -1, 295, 296, 93, -1, 299, 300, - 301, 302, 303, -1, 305, 306, 58, 59, -1, -1, - -1, 63, -1, -1, -1, -1, -1, -1, -1, 272, - 273, 274, 275, -1, -1, -1, -1, -1, 281, -1, - -1, -1, 285, 286, 287, 288, -1, 41, -1, -1, - 44, 93, 295, 296, 91, -1, 299, 300, 301, 302, - 303, -1, 305, 306, 58, 59, -1, -1, -1, 63, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 123, -1, -1, -1, - -1, 41, -1, -1, 44, -1, -1, -1, -1, 93, - -1, -1, -1, 272, 273, 274, 275, 41, 58, 59, - 44, -1, 281, 63, -1, -1, 285, 286, 287, 288, - -1, -1, -1, -1, 58, 59, 295, 296, -1, 63, - 299, 300, 301, 302, 303, -1, 305, 306, -1, -1, - -1, -1, -1, 93, -1, -1, -1, 272, 273, 274, - 275, 41, -1, -1, 44, -1, 281, -1, -1, 93, - 285, 286, 287, 288, -1, -1, -1, -1, 58, 59, - 295, 296, -1, 63, 299, 300, 301, 302, 303, -1, - 305, 306, -1, -1, -1, 272, 273, 274, 275, -1, - -1, 58, -1, -1, 281, -1, 63, -1, 285, 286, - 287, 288, -1, 93, -1, -1, -1, -1, 295, 296, - -1, -1, 299, 300, 301, 302, 303, -1, 305, 306, - -1, -1, -1, -1, 91, -1, -1, -1, -1, -1, - 272, 273, 274, 275, -1, -1, 63, -1, -1, 281, - -1, -1, -1, 285, 286, 287, 288, -1, 285, 286, - 287, 288, -1, 295, 296, -1, 123, 299, 300, 301, - 302, 303, -1, 305, 91, 302, 303, -1, 305, 306, - -1, -1, 309, -1, -1, 312, 313, 314, 272, 273, - 274, 275, -1, -1, -1, -1, -1, 281, -1, -1, - -1, 285, 286, -1, 288, 91, 123, -1, -1, -1, - -1, 295, 296, -1, -1, 299, 300, 301, 302, 303, - -1, 305, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 272, 273, 274, 275, -1, 123, -1, -1, - -1, 281, -1, -1, -1, -1, 286, -1, 272, 273, - 274, 275, -1, -1, -1, 295, 296, 281, -1, 299, - 300, 301, 302, 303, -1, -1, -1, -1, -1, -1, - -1, 295, 296, -1, -1, 299, 300, 301, 302, 303, + 281, -1, -1, -1, -1, -1, 287, 288, 289, 290, + 41, -1, -1, 44, 93, -1, 297, 298, -1, 300, + 301, 302, 303, 304, 305, 306, -1, 58, 59, -1, + -1, -1, 63, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 41, -1, -1, 44, + -1, -1, -1, 258, 287, 288, 289, 290, -1, -1, + -1, -1, 93, 58, 59, -1, -1, -1, 63, 302, + 303, 304, 305, 306, -1, -1, 309, -1, -1, 312, + 313, 314, -1, -1, -1, -1, -1, -1, -1, -1, + 295, 41, -1, -1, 44, -1, -1, -1, 93, -1, + -1, -1, 272, 273, 274, 275, -1, -1, 58, 59, + -1, 281, -1, 63, -1, -1, -1, 287, 288, 289, + 290, -1, -1, -1, -1, -1, -1, 297, 298, -1, + 300, 301, 302, 303, 304, 305, 306, -1, -1, -1, + -1, -1, -1, 93, -1, 41, -1, -1, 44, -1, + -1, -1, -1, -1, -1, 272, 273, 274, 275, -1, + -1, -1, 58, 59, 281, -1, -1, 63, -1, -1, + 287, 288, 289, 290, -1, -1, -1, -1, -1, -1, + 297, 298, -1, 300, 301, 302, 303, 304, 305, 306, + -1, -1, -1, 272, 273, 274, 275, 93, -1, -1, + -1, -1, 281, -1, -1, -1, -1, -1, 287, 288, + 289, 290, 41, -1, -1, 44, -1, -1, 297, 298, + -1, 300, 301, 302, 303, 304, 305, 306, -1, 58, + 59, -1, -1, -1, 63, -1, -1, -1, -1, -1, + -1, 272, 273, 274, 275, 41, -1, -1, 44, -1, + 281, -1, -1, -1, -1, -1, 287, 288, 289, 290, + -1, -1, 58, 59, 93, 41, 297, 298, 44, 300, + 301, 302, 303, 304, 305, 306, -1, 272, 273, 274, + 275, -1, 58, 59, -1, -1, 281, 63, -1, -1, + -1, -1, 287, 288, 289, 290, -1, 93, -1, -1, + -1, -1, 297, 298, -1, 300, 301, 302, 303, 304, + 305, 41, -1, -1, 44, -1, -1, 93, -1, -1, + -1, -1, 272, 273, 274, 275, -1, -1, 58, 59, + -1, 281, -1, 63, -1, -1, -1, 287, 288, -1, + 290, 91, -1, -1, -1, -1, -1, 297, 298, -1, + 300, 301, 302, 303, 304, 305, -1, 41, -1, -1, + 44, -1, -1, 93, 41, -1, -1, 44, -1, -1, + -1, -1, -1, 123, 58, 59, 272, 273, 274, 275, + -1, 58, 59, -1, -1, 281, 63, -1, -1, -1, + -1, 287, 288, -1, -1, -1, 41, -1, -1, 44, + -1, 297, 298, -1, 300, 301, 302, 303, 304, 93, + -1, -1, -1, 58, 59, -1, 93, -1, 63, -1, + -1, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 272, 273, 274, 275, -1, -1, -1, -1, - -1, 281, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 295, 296, -1, -1, 299, - 300, 301, 302, 303, 281, -1, -1, -1, 285, 286, - 287, 288, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 299, 300, 301, 302, 303, -1, 305, 306, - -1, -1, 309, -1, -1, 312, 313, 314, -1, -1, - -1, -1, -1, -1, 281, -1, -1, -1, 285, 286, - 287, 288, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 299, 300, 301, 302, 303, -1, 305, 306, - -1, -1, 309, -1, -1, 312, 313, 314, -1, 285, - 286, 287, 288, -1, -1, -1, -1, -1, -1, 13, - -1, -1, -1, 17, -1, 301, 302, 303, -1, 305, - 306, -1, -1, 309, -1, -1, 312, 313, 314, 33, - 34, 35, 36, -1, -1, -1, -1, -1, -1, 43, - -1, -1, -1, -1, -1, -1, -1, 51, -1, -1, + -1, -1, -1, 272, 273, 274, 275, -1, 93, 91, + -1, -1, 281, -1, -1, 63, -1, -1, 287, 288, + -1, -1, -1, -1, -1, -1, -1, -1, 297, 298, + -1, 300, 301, 302, 303, 304, 272, 273, 274, 275, + -1, 123, -1, 91, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 272, 273, 274, 275, + -1, 297, 298, -1, -1, 281, -1, -1, -1, -1, + -1, 287, 288, -1, -1, 123, -1, -1, -1, -1, + -1, 297, 298, -1, 300, 301, 302, 303, 304, -1, + -1, -1, -1, -1, -1, -1, -1, 287, 288, 289, + 290, -1, 272, 273, 274, 275, -1, -1, -1, -1, + -1, 281, -1, 303, 304, 305, 306, 287, 288, 309, + -1, -1, 312, 313, 314, -1, -1, 297, 298, -1, + 300, 301, 302, 303, 304, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 272, 273, + 274, 275, -1, -1, -1, 272, 273, 274, 275, -1, + -1, -1, -1, -1, 281, -1, -1, -1, -1, -1, + -1, -1, -1, 297, 298, -1, -1, -1, -1, -1, + 297, 298, -1, 300, 301, 302, 303, 272, 273, 274, + 275, -1, -1, -1, -1, -1, 281, -1, -1, 281, + -1, -1, -1, -1, -1, 287, 288, 289, 290, -1, + -1, -1, 297, 298, -1, 300, 301, 302, 300, 301, + 302, 303, 304, 305, 306, -1, -1, 309, -1, -1, + 312, 313, 314, 281, -1, -1, -1, -1, -1, 287, + 288, 289, 290, -1, -1, -1, -1, 13, -1, -1, + -1, 17, -1, 301, 302, 303, 304, 305, 306, -1, + -1, 309, -1, -1, 312, 313, 314, 33, 34, 35, + 36, -1, -1, -1, -1, -1, 42, -1, -1, 45, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 94, -1, -1, 97, -1, 99, -1, 101, -1, 103, + -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 94, -1, + -1, 97, -1, 99, -1, 101, -1, 103, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 144, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 144, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 181, -1, -1, - -1, -1, -1, -1, 188, + -1, -1, -1, -1, -1, 181, -1, -1, -1, -1, + -1, -1, 188, }; #define YYFINAL 1 #ifndef YYDEBUG @@ -1092,9 +1073,9 @@ char *yyname[] = { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,"WORD","METHOD","FUNCMETH","THING", "PMFUNC","PRIVATEREF","FUNC0SUB","UNIOPSUB","LSTOPSUB","LABEL","FORMAT","SUB", "ANONSUB","PACKAGE","USE","WHILE","UNTIL","IF","UNLESS","ELSE","ELSIF", -"CONTINUE","FOR","LOOPEX","DOTDOT","FUNC0","FUNC1","FUNC","RELOP","EQOP", -"MULOP","ADDOP","DOLSHARP","DO","HASHBRACK","NOAMP","LOCAL","MY","OROP","ANDOP", -"NOTOP","LSTOP","ASSIGNOP","OROR","ANDAND","BITOROP","BITANDOP","UNIOP", +"CONTINUE","FOR","LOOPEX","DOTDOT","FUNC0","FUNC1","FUNC","UNIOP","LSTOP", +"RELOP","EQOP","MULOP","ADDOP","DOLSHARP","DO","HASHBRACK","NOAMP","LOCAL","MY", +"OROP","ANDOP","NOTOP","ASSIGNOP","OROR","ANDAND","BITOROP","BITANDOP", "SHIFTOP","MATCHOP","UMINUS","REFGEN","POWOP","PREINC","PREDEC","POSTINC", "POSTDEC","ARROW", }; @@ -1292,9 +1273,9 @@ int yyerrflag; int yychar; YYSTYPE yyval; YYSTYPE yylval; -#line 616 "perly.y" +#line 620 "perly.y" /* PROGRAM */ -#line 1369 "perly.c" +#line 1349 "perly.c" #define YYABORT goto yyabort #define YYACCEPT goto yyaccept #define YYERROR goto yyerrlab @@ -1533,41 +1514,45 @@ case 2: break; case 3: #line 96 "perly.y" -{ yyval.opval = block_end(yyvsp[-3].ival,yyvsp[-2].ival,yyvsp[-1].opval); } +{ if (copline > (line_t)yyvsp[-3].ival) + copline = yyvsp[-3].ival; + yyval.opval = block_end(yyvsp[-2].ival, yyvsp[-1].opval); } break; case 4: -#line 100 "perly.y" +#line 102 "perly.y" { yyval.ival = block_start(TRUE); } break; case 5: -#line 104 "perly.y" -{ yyval.opval = block_end(yyvsp[-3].ival,yyvsp[-2].ival,yyvsp[-1].opval); } +#line 106 "perly.y" +{ if (copline > (line_t)yyvsp[-3].ival) + copline = yyvsp[-3].ival; + yyval.opval = block_end(yyvsp[-2].ival, yyvsp[-1].opval); } break; case 6: -#line 108 "perly.y" +#line 112 "perly.y" { yyval.ival = block_start(FALSE); } break; case 7: -#line 112 "perly.y" +#line 116 "perly.y" { yyval.opval = Nullop; } break; case 8: -#line 114 "perly.y" +#line 118 "perly.y" { yyval.opval = yyvsp[-1].opval; } break; case 9: -#line 116 "perly.y" +#line 120 "perly.y" { yyval.opval = append_list(OP_LINESEQ, (LISTOP*)yyvsp[-1].opval, (LISTOP*)yyvsp[0].opval); pad_reset_pending = TRUE; if (yyvsp[-1].opval && yyvsp[0].opval) hints |= HINT_BLOCK_SCOPE; } break; case 10: -#line 123 "perly.y" +#line 127 "perly.y" { yyval.opval = newSTATEOP(0, yyvsp[-1].pval, yyvsp[0].opval); } break; case 12: -#line 126 "perly.y" +#line 130 "perly.y" { if (yyvsp[-1].pval != Nullch) { yyval.opval = newSTATEOP(0, yyvsp[-1].pval, newOP(OP_NULL, 0)); } @@ -1578,131 +1563,131 @@ case 12: expect = XSTATE; } break; case 13: -#line 135 "perly.y" +#line 139 "perly.y" { yyval.opval = newSTATEOP(0, yyvsp[-2].pval, yyvsp[-1].opval); expect = XSTATE; } break; case 14: -#line 140 "perly.y" +#line 144 "perly.y" { yyval.opval = Nullop; } break; case 15: -#line 142 "perly.y" +#line 146 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 16: -#line 144 "perly.y" +#line 148 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[0].opval, yyvsp[-2].opval); } break; case 17: -#line 146 "perly.y" +#line 150 "perly.y" { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[0].opval, yyvsp[-2].opval); } break; case 18: -#line 148 "perly.y" +#line 152 "perly.y" { yyval.opval = newLOOPOP(OPf_PARENS, 1, scalar(yyvsp[0].opval), yyvsp[-2].opval); } break; case 19: -#line 150 "perly.y" +#line 154 "perly.y" { yyval.opval = newLOOPOP(OPf_PARENS, 1, yyvsp[0].opval, yyvsp[-2].opval);} break; case 20: -#line 154 "perly.y" +#line 158 "perly.y" { yyval.opval = Nullop; } break; case 21: -#line 156 "perly.y" +#line 160 "perly.y" { yyval.opval = scope(yyvsp[0].opval); } break; case 22: -#line 158 "perly.y" +#line 162 "perly.y" { copline = yyvsp[-5].ival; yyval.opval = newSTATEOP(0, Nullch, newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); hints |= HINT_BLOCK_SCOPE; } break; case 23: -#line 165 "perly.y" +#line 169 "perly.y" { copline = yyvsp[-6].ival; - yyval.opval = block_end(yyvsp[-6].ival, yyvsp[-4].ival, + yyval.opval = block_end(yyvsp[-4].ival, newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); } break; case 24: -#line 169 "perly.y" +#line 173 "perly.y" { copline = yyvsp[-6].ival; - yyval.opval = block_end(yyvsp[-6].ival, yyvsp[-4].ival, + yyval.opval = block_end(yyvsp[-4].ival, newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); } break; case 25: -#line 173 "perly.y" +#line 177 "perly.y" { copline = yyvsp[-3].ival; deprecate("if BLOCK BLOCK"); yyval.opval = newCONDOP(0, scope(yyvsp[-2].opval), scope(yyvsp[-1].opval), yyvsp[0].opval); } break; case 26: -#line 177 "perly.y" +#line 181 "perly.y" { copline = yyvsp[-3].ival; deprecate("unless BLOCK BLOCK"); yyval.opval = newCONDOP(0, invert(scalar(scope(yyvsp[-2].opval))), scope(yyvsp[-1].opval), yyvsp[0].opval); } break; case 27: -#line 184 "perly.y" +#line 188 "perly.y" { yyval.opval = Nullop; } break; case 28: -#line 186 "perly.y" +#line 190 "perly.y" { yyval.opval = scope(yyvsp[0].opval); } break; case 29: -#line 190 "perly.y" +#line 194 "perly.y" { copline = yyvsp[-6].ival; - yyval.opval = block_end(yyvsp[-6].ival, yyvsp[-4].ival, + yyval.opval = block_end(yyvsp[-4].ival, newSTATEOP(0, yyvsp[-7].pval, newWHILEOP(0, 1, (LOOP*)Nullop, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval))); } break; case 30: -#line 196 "perly.y" +#line 200 "perly.y" { copline = yyvsp[-6].ival; - yyval.opval = block_end(yyvsp[-6].ival, yyvsp[-4].ival, + yyval.opval = block_end(yyvsp[-4].ival, newSTATEOP(0, yyvsp[-7].pval, newWHILEOP(0, 1, (LOOP*)Nullop, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval))); } break; case 31: -#line 202 "perly.y" +#line 206 "perly.y" { copline = yyvsp[-3].ival; yyval.opval = newWHILEOP(0, 1, (LOOP*)Nullop, scope(yyvsp[-2].opval), yyvsp[-1].opval, yyvsp[0].opval); } break; case 32: -#line 206 "perly.y" +#line 210 "perly.y" { copline = yyvsp[-3].ival; yyval.opval = newWHILEOP(0, 1, (LOOP*)Nullop, invert(scalar(scope(yyvsp[-2].opval))), yyvsp[-1].opval, yyvsp[0].opval); } break; case 33: -#line 211 "perly.y" -{ yyval.opval = block_end(yyvsp[-8].ival, yyvsp[-6].ival, +#line 215 "perly.y" +{ yyval.opval = block_end(yyvsp[-6].ival, newFOROP(0, yyvsp[-9].pval, yyvsp[-8].ival, yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); } break; case 34: -#line 214 "perly.y" -{ yyval.opval = block_end(yyvsp[-7].ival, yyvsp[-4].ival, +#line 218 "perly.y" +{ yyval.opval = block_end(yyvsp[-4].ival, newFOROP(0, yyvsp[-8].pval, yyvsp[-7].ival, mod(yyvsp[-6].opval, OP_ENTERLOOP), yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); } break; case 35: -#line 218 "perly.y" -{ yyval.opval = block_end(yyvsp[-6].ival, yyvsp[-4].ival, +#line 222 "perly.y" +{ yyval.opval = block_end(yyvsp[-4].ival, newFOROP(0, yyvsp[-7].pval, yyvsp[-6].ival, Nullop, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); } break; case 36: -#line 222 "perly.y" +#line 226 "perly.y" { copline = yyvsp[-9].ival; - yyval.opval = block_end(yyvsp[-9].ival, yyvsp[-7].ival, + yyval.opval = block_end(yyvsp[-7].ival, append_elem(OP_LINESEQ, scalar(yyvsp[-6].opval), newSTATEOP(0, yyvsp[-10].pval, newWHILEOP(0, 1, (LOOP*)Nullop, @@ -1710,356 +1695,356 @@ case 36: yyvsp[0].opval, scalar(yyvsp[-2].opval))))); } break; case 37: -#line 230 "perly.y" +#line 234 "perly.y" { yyval.opval = newSTATEOP(0, yyvsp[-2].pval, newWHILEOP(0, 1, (LOOP*)Nullop, Nullop, yyvsp[-1].opval, yyvsp[0].opval)); } break; case 38: -#line 236 "perly.y" +#line 240 "perly.y" { yyval.opval = Nullop; } break; case 40: -#line 241 "perly.y" +#line 245 "perly.y" { (void)scan_num("1"); yyval.opval = yylval.opval; } break; case 42: -#line 246 "perly.y" +#line 250 "perly.y" { yyval.opval = invert(scalar(yyvsp[0].opval)); } break; case 43: -#line 250 "perly.y" +#line 254 "perly.y" { yyval.opval = yyvsp[0].opval; intro_my(); } break; case 44: -#line 254 "perly.y" +#line 258 "perly.y" { yyval.opval = yyvsp[0].opval; intro_my(); } break; case 45: -#line 258 "perly.y" +#line 262 "perly.y" { yyval.opval = yyvsp[0].opval; intro_my(); } break; case 46: -#line 262 "perly.y" +#line 266 "perly.y" { yyval.opval = yyvsp[0].opval; intro_my(); } break; case 47: -#line 266 "perly.y" +#line 270 "perly.y" { yyval.pval = Nullch; } break; case 49: -#line 271 "perly.y" +#line 275 "perly.y" { yyval.ival = 0; } break; case 50: -#line 273 "perly.y" +#line 277 "perly.y" { yyval.ival = 0; } break; case 51: -#line 275 "perly.y" +#line 279 "perly.y" { yyval.ival = 0; } break; case 52: -#line 277 "perly.y" +#line 281 "perly.y" { yyval.ival = 0; } break; case 53: -#line 281 "perly.y" +#line 285 "perly.y" { newFORM(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); } break; case 54: -#line 283 "perly.y" +#line 287 "perly.y" { newFORM(yyvsp[-1].ival, Nullop, yyvsp[0].opval); } break; case 55: -#line 287 "perly.y" +#line 291 "perly.y" { newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, yyvsp[0].opval); } break; case 56: -#line 289 "perly.y" +#line 293 "perly.y" { newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, Nullop); expect = XSTATE; } break; case 57: -#line 293 "perly.y" +#line 297 "perly.y" { yyval.opval = Nullop; } break; case 59: -#line 298 "perly.y" +#line 302 "perly.y" { yyval.ival = start_subparse(); } break; case 60: -#line 302 "perly.y" +#line 306 "perly.y" { package(yyvsp[-1].opval); } break; case 61: -#line 304 "perly.y" +#line 308 "perly.y" { package(Nullop); } break; case 62: -#line 308 "perly.y" +#line 312 "perly.y" { utilize(yyvsp[-5].ival, yyvsp[-4].ival, yyvsp[-3].opval, yyvsp[-2].opval, yyvsp[-1].opval); } break; case 63: -#line 312 "perly.y" +#line 316 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 64: -#line 314 "perly.y" +#line 318 "perly.y" { yyval.opval = newLOGOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 66: -#line 319 "perly.y" +#line 323 "perly.y" { yyval.opval = yyvsp[-1].opval; } break; case 67: -#line 321 "perly.y" +#line 325 "perly.y" { yyval.opval = append_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval); } break; case 69: -#line 326 "perly.y" +#line 330 "perly.y" { yyval.opval = convert(yyvsp[-2].ival, OPf_STACKED, prepend_elem(OP_LIST, newGVREF(yyvsp[-2].ival,yyvsp[-1].opval), yyvsp[0].opval) ); } break; case 70: -#line 329 "perly.y" +#line 333 "perly.y" { yyval.opval = convert(yyvsp[-4].ival, OPf_STACKED, prepend_elem(OP_LIST, newGVREF(yyvsp[-4].ival,yyvsp[-2].opval), yyvsp[-1].opval) ); } break; case 71: -#line 332 "perly.y" +#line 336 "perly.y" { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, scalar(yyvsp[-5].opval), yyvsp[-1].opval), newUNOP(OP_METHOD, 0, yyvsp[-3].opval))); } break; case 72: -#line 337 "perly.y" +#line 341 "perly.y" { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, yyvsp[-1].opval, yyvsp[0].opval), newUNOP(OP_METHOD, 0, yyvsp[-2].opval))); } break; case 73: -#line 342 "perly.y" +#line 346 "perly.y" { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, yyvsp[-3].opval, yyvsp[-1].opval), newUNOP(OP_METHOD, 0, yyvsp[-4].opval))); } break; case 74: -#line 347 "perly.y" +#line 351 "perly.y" { yyval.opval = convert(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 75: -#line 349 "perly.y" +#line 353 "perly.y" { yyval.opval = convert(yyvsp[-3].ival, 0, yyvsp[-1].opval); } break; case 76: -#line 351 "perly.y" +#line 355 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, prepend_elem(OP_LIST, newANONSUB(yyvsp[-2].ival, 0, yyvsp[-1].opval), yyvsp[0].opval), yyvsp[-3].opval)); } break; case 79: -#line 362 "perly.y" +#line 366 "perly.y" { yyval.opval = newASSIGNOP(OPf_STACKED, yyvsp[-2].opval, yyvsp[-1].ival, yyvsp[0].opval); } break; case 80: -#line 364 "perly.y" +#line 368 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 81: -#line 366 "perly.y" +#line 370 "perly.y" { if (yyvsp[-1].ival != OP_REPEAT) scalar(yyvsp[-2].opval); yyval.opval = newBINOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, scalar(yyvsp[0].opval)); } break; case 82: -#line 370 "perly.y" +#line 374 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 83: -#line 372 "perly.y" +#line 376 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 84: -#line 374 "perly.y" +#line 378 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 85: -#line 376 "perly.y" +#line 380 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 86: -#line 378 "perly.y" +#line 382 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 87: -#line 380 "perly.y" +#line 384 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 88: -#line 382 "perly.y" +#line 386 "perly.y" { yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));} break; case 89: -#line 384 "perly.y" +#line 388 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 90: -#line 386 "perly.y" +#line 390 "perly.y" { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 91: -#line 388 "perly.y" +#line 392 "perly.y" { yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); } break; case 92: -#line 390 "perly.y" +#line 394 "perly.y" { yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); } break; case 93: -#line 393 "perly.y" +#line 397 "perly.y" { yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); } break; case 94: -#line 395 "perly.y" +#line 399 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 95: -#line 397 "perly.y" +#line 401 "perly.y" { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } break; case 96: -#line 399 "perly.y" +#line 403 "perly.y" { yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));} break; case 97: -#line 401 "perly.y" +#line 405 "perly.y" { yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); } break; case 98: -#line 403 "perly.y" +#line 407 "perly.y" { yyval.opval = newUNOP(OP_POSTINC, 0, mod(scalar(yyvsp[-1].opval), OP_POSTINC)); } break; case 99: -#line 406 "perly.y" +#line 410 "perly.y" { yyval.opval = newUNOP(OP_POSTDEC, 0, mod(scalar(yyvsp[-1].opval), OP_POSTDEC)); } break; case 100: -#line 409 "perly.y" +#line 413 "perly.y" { yyval.opval = newUNOP(OP_PREINC, 0, mod(scalar(yyvsp[0].opval), OP_PREINC)); } break; case 101: -#line 412 "perly.y" +#line 416 "perly.y" { yyval.opval = newUNOP(OP_PREDEC, 0, mod(scalar(yyvsp[0].opval), OP_PREDEC)); } break; case 102: -#line 415 "perly.y" +#line 419 "perly.y" { yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); } break; case 103: -#line 417 "perly.y" +#line 421 "perly.y" { yyval.opval = sawparens(yyvsp[-1].opval); } break; case 104: -#line 419 "perly.y" +#line 423 "perly.y" { yyval.opval = sawparens(newNULLLIST()); } break; case 105: -#line 421 "perly.y" +#line 425 "perly.y" { yyval.opval = newANONLIST(yyvsp[-1].opval); } break; case 106: -#line 423 "perly.y" +#line 427 "perly.y" { yyval.opval = newANONLIST(Nullop); } break; case 107: -#line 425 "perly.y" +#line 429 "perly.y" { yyval.opval = newANONHASH(yyvsp[-2].opval); } break; case 108: -#line 427 "perly.y" +#line 431 "perly.y" { yyval.opval = newANONHASH(Nullop); } break; case 109: -#line 429 "perly.y" +#line 433 "perly.y" { yyval.opval = newANONSUB(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); } break; case 110: -#line 431 "perly.y" +#line 435 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 111: -#line 433 "perly.y" +#line 437 "perly.y" { yyval.opval = newBINOP(OP_GELEM, 0, newGVREF(0,yyvsp[-4].opval), yyvsp[-2].opval); } break; case 112: -#line 435 "perly.y" +#line 439 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 113: -#line 437 "perly.y" +#line 441 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); } break; case 114: -#line 439 "perly.y" +#line 443 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, ref(newAVREF(yyvsp[-4].opval),OP_RV2AV), scalar(yyvsp[-1].opval));} break; case 115: -#line 443 "perly.y" +#line 447 "perly.y" { assertref(yyvsp[-3].opval); yyval.opval = newBINOP(OP_AELEM, 0, ref(newAVREF(yyvsp[-3].opval),OP_RV2AV), scalar(yyvsp[-1].opval));} break; case 116: -#line 447 "perly.y" +#line 451 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 117: -#line 449 "perly.y" +#line 453 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 118: -#line 451 "perly.y" +#line 455 "perly.y" { yyval.opval = newUNOP(OP_AV2ARYLEN, 0, ref(yyvsp[0].opval, OP_AV2ARYLEN));} break; case 119: -#line 453 "perly.y" +#line 457 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval)); expect = XOPERATOR; } break; case 120: -#line 456 "perly.y" +#line 460 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, ref(newHVREF(yyvsp[-5].opval),OP_RV2HV), jmaybe(yyvsp[-2].opval)); expect = XOPERATOR; } break; case 121: -#line 461 "perly.y" +#line 465 "perly.y" { assertref(yyvsp[-4].opval); yyval.opval = newBINOP(OP_HELEM, 0, ref(newHVREF(yyvsp[-4].opval),OP_RV2HV), jmaybe(yyvsp[-2].opval)); expect = XOPERATOR; } break; case 122: -#line 466 "perly.y" +#line 470 "perly.y" { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, yyvsp[-4].opval); } break; case 123: -#line 468 "perly.y" +#line 472 "perly.y" { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, Nullop); } break; case 124: -#line 470 "perly.y" +#line 474 "perly.y" { yyval.opval = prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -2067,7 +2052,7 @@ case 124: ref(yyvsp[-3].opval, OP_ASLICE))); } break; case 125: -#line 476 "perly.y" +#line 480 "perly.y" { yyval.opval = prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -2076,37 +2061,37 @@ case 125: expect = XOPERATOR; } break; case 126: -#line 483 "perly.y" +#line 487 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 127: -#line 485 "perly.y" +#line 489 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); } break; case 128: -#line 487 "perly.y" +#line 491 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar(yyvsp[-2].opval)); } break; case 129: -#line 489 "perly.y" +#line 493 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[-1].opval, scalar(yyvsp[-3].opval))); } break; case 130: -#line 492 "perly.y" +#line 496 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); } break; case 131: -#line 495 "perly.y" +#line 499 "perly.y" { yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); } break; case 132: -#line 497 "perly.y" +#line 501 "perly.y" { yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); } break; case 133: -#line 499 "perly.y" +#line 503 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, @@ -2116,7 +2101,7 @@ case 133: )),Nullop)); dep();} break; case 134: -#line 507 "perly.y" +#line 511 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, append_elem(OP_LIST, @@ -2127,150 +2112,150 @@ case 134: )))); dep();} break; case 135: -#line 516 "perly.y" +#line 520 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, scalar(newCVREF(0,scalar(yyvsp[-2].opval))), Nullop)); dep();} break; case 136: -#line 520 "perly.y" +#line 524 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, prepend_elem(OP_LIST, yyvsp[-1].opval, scalar(newCVREF(0,scalar(yyvsp[-3].opval))))); dep();} break; case 137: -#line 525 "perly.y" +#line 529 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL); hints |= HINT_BLOCK_SCOPE; } break; case 138: -#line 528 "perly.y" +#line 532 "perly.y" { yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); } break; case 139: -#line 530 "perly.y" +#line 534 "perly.y" { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } break; case 140: -#line 532 "perly.y" +#line 536 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, 0); } break; case 141: -#line 534 "perly.y" +#line 538 "perly.y" { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 142: -#line 536 "perly.y" +#line 540 "perly.y" { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 143: -#line 538 "perly.y" +#line 542 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); } break; case 144: -#line 541 "perly.y" +#line 545 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, 0); } break; case 145: -#line 543 "perly.y" +#line 547 "perly.y" { yyval.opval = newOP(yyvsp[-2].ival, 0); } break; case 146: -#line 545 "perly.y" +#line 549 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); } break; case 147: -#line 548 "perly.y" +#line 552 "perly.y" { yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); } break; case 148: -#line 550 "perly.y" +#line 554 "perly.y" { yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); } break; case 149: -#line 552 "perly.y" +#line 556 "perly.y" { yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); } break; case 150: -#line 554 "perly.y" +#line 558 "perly.y" { yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); } break; case 153: -#line 560 "perly.y" +#line 564 "perly.y" { yyval.opval = Nullop; } break; case 154: -#line 562 "perly.y" +#line 566 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 155: -#line 566 "perly.y" +#line 570 "perly.y" { yyval.opval = Nullop; } break; case 156: -#line 568 "perly.y" +#line 572 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 157: -#line 570 "perly.y" +#line 574 "perly.y" { yyval.opval = yyvsp[-1].opval; } break; case 158: -#line 573 "perly.y" +#line 577 "perly.y" { yyval.ival = 0; } break; case 159: -#line 574 "perly.y" +#line 578 "perly.y" { yyval.ival = 1; } break; case 160: -#line 578 "perly.y" +#line 582 "perly.y" { in_my = 0; yyval.opval = my(yyvsp[0].opval); } break; case 161: -#line 582 "perly.y" +#line 586 "perly.y" { yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); } break; case 162: -#line 586 "perly.y" +#line 590 "perly.y" { yyval.opval = newSVREF(yyvsp[0].opval); } break; case 163: -#line 590 "perly.y" +#line 594 "perly.y" { yyval.opval = newAVREF(yyvsp[0].opval); } break; case 164: -#line 594 "perly.y" +#line 598 "perly.y" { yyval.opval = newHVREF(yyvsp[0].opval); } break; case 165: -#line 598 "perly.y" +#line 602 "perly.y" { yyval.opval = newAVREF(yyvsp[0].opval); } break; case 166: -#line 602 "perly.y" +#line 606 "perly.y" { yyval.opval = newGVREF(0,yyvsp[0].opval); } break; case 167: -#line 606 "perly.y" +#line 610 "perly.y" { yyval.opval = scalar(yyvsp[0].opval); } break; case 168: -#line 608 "perly.y" +#line 612 "perly.y" { yyval.opval = scalar(yyvsp[0].opval); } break; case 169: -#line 610 "perly.y" +#line 614 "perly.y" { yyval.opval = scope(yyvsp[0].opval); } break; case 170: -#line 613 "perly.y" +#line 617 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -#line 2261 "perly.c" +#line 2245 "perly.c" } yyssp -= yym; yystate = *yyssp; diff --git a/perly.c.diff b/perly.c.diff index 3f4ab02..172fae5 100644 --- a/perly.c.diff +++ b/perly.c.diff @@ -1,79 +1,85 @@ -Index: perly.c +*** y.tab.c.ORIG Thu Dec 5 13:55:38 1996 +--- y.tab.c Thu Dec 5 13:56:27 1996 *************** *** 13,82 **** } -- #line 29 "perly.y" -- typedef union { -- I32 ival; -- char *pval; -- OP *opval; -- GV *gvval; -- } YYSTYPE; -- #line 23 "y.tab.c" -- #define WORD 257 -- #define METHOD 258 -- #define FUNCMETH 259 -- #define THING 260 -- #define PMFUNC 261 -- #define PRIVATEREF 262 -- #define FUNC0SUB 263 -- #define UNIOPSUB 264 -- #define LSTOPSUB 265 -- #define LABEL 266 -- #define FORMAT 267 -- #define SUB 268 -- #define ANONSUB 269 -- #define PACKAGE 270 -- #define USE 271 -- #define WHILE 272 -- #define UNTIL 273 -- #define IF 274 -- #define UNLESS 275 -- #define ELSE 276 -- #define ELSIF 277 -- #define CONTINUE 278 -- #define FOR 279 -- #define LOOPEX 280 -- #define DOTDOT 281 -- #define FUNC0 282 -- #define FUNC1 283 -- #define FUNC 284 -- #define RELOP 285 -- #define EQOP 286 -- #define MULOP 287 -- #define ADDOP 288 -- #define DOLSHARP 289 -- #define DO 290 -- #define HASHBRACK 291 -- #define NOAMP 292 -- #define LOCAL 293 -- #define MY 294 -- #define OROP 295 -- #define ANDOP 296 -- #define NOTOP 297 -- #define LSTOP 298 -- #define ASSIGNOP 299 -- #define OROR 300 -- #define ANDAND 301 -- #define BITOROP 302 -- #define BITANDOP 303 -- #define UNIOP 304 -- #define SHIFTOP 305 -- #define MATCHOP 306 -- #define UMINUS 307 -- #define REFGEN 308 -- #define POWOP 309 -- #define PREINC 310 -- #define PREDEC 311 -- #define POSTINC 312 -- #define POSTDEC 313 -- #define ARROW 314 +! #line 29 "perly.y" +! typedef union { +! I32 ival; +! char *pval; +! OP *opval; +! GV *gvval; +! } YYSTYPE; +! #line 23 "y.tab.c" +! #define WORD 257 +! #define METHOD 258 +! #define FUNCMETH 259 +! #define THING 260 +! #define PMFUNC 261 +! #define PRIVATEREF 262 +! #define FUNC0SUB 263 +! #define UNIOPSUB 264 +! #define LSTOPSUB 265 +! #define LABEL 266 +! #define FORMAT 267 +! #define SUB 268 +! #define ANONSUB 269 +! #define PACKAGE 270 +! #define USE 271 +! #define WHILE 272 +! #define UNTIL 273 +! #define IF 274 +! #define UNLESS 275 +! #define ELSE 276 +! #define ELSIF 277 +! #define CONTINUE 278 +! #define FOR 279 +! #define LOOPEX 280 +! #define DOTDOT 281 +! #define FUNC0 282 +! #define FUNC1 283 +! #define FUNC 284 +! #define UNIOP 285 +! #define LSTOP 286 +! #define RELOP 287 +! #define EQOP 288 +! #define MULOP 289 +! #define ADDOP 290 +! #define DOLSHARP 291 +! #define DO 292 +! #define HASHBRACK 293 +! #define NOAMP 294 +! #define LOCAL 295 +! #define MY 296 +! #define OROP 297 +! #define ANDOP 298 +! #define NOTOP 299 +! #define ASSIGNOP 300 +! #define OROR 301 +! #define ANDAND 302 +! #define BITOROP 303 +! #define BITANDOP 304 +! #define SHIFTOP 305 +! #define MATCHOP 306 +! #define UMINUS 307 +! #define REFGEN 308 +! #define POWOP 309 +! #define PREINC 310 +! #define PREDEC 311 +! #define POSTINC 312 +! #define POSTDEC 313 +! #define ARROW 314 + #define YYERRCODE 256 + short yylhs[] = { -1, +--- 13,17 ---- + } + +! #line 16 "perly.c" #define YYERRCODE 256 short yylhs[] = { -1, ---- 13,16 ---- *************** -*** 1357,1367 **** +*** 1337,1347 **** int yyerrflag; int yychar; - short *yyssp; @@ -83,12 +89,12 @@ Index: perly.c - short yyss[YYSTACKSIZE]; - YYSTYPE yyvs[YYSTACKSIZE]; - #define yystacksize YYSTACKSIZE - #line 616 "perly.y" + #line 620 "perly.y" /* PROGRAM */ ---- 1291,1296 ---- +--- 1272,1277 ---- *************** -*** 1370,1381 **** ---- 1299,1355 ---- +*** 1350,1361 **** +--- 1280,1336 ---- #define YYACCEPT goto yyaccept #define YYERROR goto yyerrlab + @@ -147,8 +153,8 @@ Index: perly.c if (yys = getenv("YYDEBUG")) { *************** -*** 1390,1393 **** ---- 1364,1375 ---- +*** 1370,1373 **** +--- 1345,1356 ---- yychar = (-1); + /* @@ -162,20 +168,20 @@ Index: perly.c yyssp = yyss; yyvsp = yyvs; *************** -*** 1405,1409 **** +*** 1385,1389 **** if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! printf("yydebug: state %d, reading %d (%s)\n", yystate, yychar, yys); } ---- 1387,1391 ---- +--- 1368,1372 ---- if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! fprintf(stderr, "yydebug: state %d, reading %d (%s)\n", yystate, yychar, yys); } *************** -*** 1415,1424 **** +*** 1395,1404 **** #if YYDEBUG if (yydebug) ! printf("yydebug: state %d, shifting to state %d\n", @@ -186,7 +192,7 @@ Index: perly.c ! goto yyoverflow; } *++yyssp = yystate = yytable[yyn]; ---- 1397,1420 ---- +--- 1378,1401 ---- #if YYDEBUG if (yydebug) ! fprintf(stderr, "yydebug: state %d, shifting to state %d\n", @@ -212,7 +218,7 @@ Index: perly.c } *++yyssp = yystate = yytable[yyn]; *************** -*** 1456,1465 **** +*** 1436,1445 **** #if YYDEBUG if (yydebug) ! printf("yydebug: state %d, error recovery shifting\ @@ -223,7 +229,7 @@ Index: perly.c ! goto yyoverflow; } *++yyssp = yystate = yytable[yyn]; ---- 1452,1476 ---- +--- 1433,1457 ---- #if YYDEBUG if (yydebug) ! fprintf(stderr, @@ -250,14 +256,14 @@ Index: perly.c } *++yyssp = yystate = yytable[yyn]; *************** -*** 1471,1476 **** +*** 1451,1456 **** #if YYDEBUG if (yydebug) ! printf("yydebug: error recovery discarding state %d\n", ! *yyssp); #endif if (yyssp <= yyss) goto yyabort; ---- 1482,1488 ---- +--- 1463,1469 ---- #if YYDEBUG if (yydebug) ! fprintf(stderr, @@ -266,14 +272,14 @@ Index: perly.c #endif if (yyssp <= yyss) goto yyabort; *************** -*** 1489,1494 **** +*** 1469,1474 **** if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! printf("yydebug: state %d, error recovery discards token %d (%s)\n", ! yystate, yychar, yys); } #endif ---- 1501,1507 ---- +--- 1482,1488 ---- if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! fprintf(stderr, @@ -282,27 +288,27 @@ Index: perly.c } #endif *************** -*** 1499,1503 **** +*** 1479,1483 **** #if YYDEBUG if (yydebug) ! printf("yydebug: state %d, reducing by rule %d (%s)\n", yystate, yyn, yyrule[yyn]); #endif ---- 1512,1516 ---- +--- 1493,1497 ---- #if YYDEBUG if (yydebug) ! fprintf(stderr, "yydebug: state %d, reducing by rule %d (%s)\n", yystate, yyn, yyrule[yyn]); #endif *************** -*** 2268,2273 **** +*** 2252,2257 **** #if YYDEBUG if (yydebug) ! printf("yydebug: after reduction, shifting from state 0 to\ ! state %d\n", YYFINAL); #endif yystate = YYFINAL; ---- 2281,2287 ---- +--- 2266,2272 ---- #if YYDEBUG if (yydebug) ! fprintf(stderr, @@ -311,20 +317,20 @@ Index: perly.c #endif yystate = YYFINAL; *************** -*** 2283,2287 **** +*** 2267,2271 **** if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! printf("yydebug: state %d, reading %d (%s)\n", YYFINAL, yychar, yys); } ---- 2297,2301 ---- +--- 2282,2286 ---- if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! fprintf(stderr, "yydebug: state %d, reading %d (%s)\n", YYFINAL, yychar, yys); } *************** -*** 2298,2307 **** +*** 2282,2291 **** #if YYDEBUG if (yydebug) ! printf("yydebug: after reduction, shifting from state %d \ @@ -335,7 +341,7 @@ Index: perly.c ! goto yyoverflow; } *++yyssp = yystate; ---- 2312,2336 ---- +--- 2297,2321 ---- #if YYDEBUG if (yydebug) ! fprintf(stderr, @@ -362,7 +368,7 @@ Index: perly.c } *++yyssp = yystate; *************** -*** 2309,2316 **** +*** 2293,2300 **** goto yyloop; yyoverflow: ! yyerror("yacc stack overflow"); @@ -371,7 +377,7 @@ Index: perly.c yyaccept: ! return (0); } ---- 2338,2345 ---- +--- 2323,2330 ---- goto yyloop; yyoverflow: ! yyerror("Out of memory for yacc stack"); diff --git a/perly.h b/perly.h index 1d9f7ad..9907727 100644 --- a/perly.h +++ b/perly.h @@ -26,26 +26,26 @@ #define FUNC0 282 #define FUNC1 283 #define FUNC 284 -#define RELOP 285 -#define EQOP 286 -#define MULOP 287 -#define ADDOP 288 -#define DOLSHARP 289 -#define DO 290 -#define HASHBRACK 291 -#define NOAMP 292 -#define LOCAL 293 -#define MY 294 -#define OROP 295 -#define ANDOP 296 -#define NOTOP 297 -#define LSTOP 298 -#define ASSIGNOP 299 -#define OROR 300 -#define ANDAND 301 -#define BITOROP 302 -#define BITANDOP 303 -#define UNIOP 304 +#define UNIOP 285 +#define LSTOP 286 +#define RELOP 287 +#define EQOP 288 +#define MULOP 289 +#define ADDOP 290 +#define DOLSHARP 291 +#define DO 292 +#define HASHBRACK 293 +#define NOAMP 294 +#define LOCAL 295 +#define MY 296 +#define OROP 297 +#define ANDOP 298 +#define NOTOP 299 +#define ASSIGNOP 300 +#define OROR 301 +#define ANDAND 302 +#define BITOROP 303 +#define BITANDOP 304 #define SHIFTOP 305 #define MATCHOP 306 #define UMINUS 307 diff --git a/perly.y b/perly.y index 6d3c75c..b4d8c4f 100644 --- a/perly.y +++ b/perly.y @@ -41,7 +41,7 @@ dep() %token FORMAT SUB ANONSUB PACKAGE USE %token WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE FOR %token LOOPEX DOTDOT -%token FUNC0 FUNC1 FUNC +%token FUNC0 FUNC1 FUNC UNIOP LSTOP %token RELOP EQOP MULOP ADDOP %token DOLSHARP DO HASHBRACK NOAMP %token LOCAL MY @@ -57,7 +57,7 @@ dep() %left OROP %left ANDOP %right NOTOP -%nonassoc LSTOP +%nonassoc LSTOP LSTOPSUB %left ',' %right ASSIGNOP %right '?' ':' @@ -68,7 +68,7 @@ dep() %left BITANDOP %nonassoc EQOP %nonassoc RELOP -%nonassoc UNIOP +%nonassoc UNIOP UNIOPSUB %left SHIFTOP %left ADDOP %left MULOP @@ -93,7 +93,9 @@ prog : /* NULL */ ; block : '{' remember lineseq '}' - { $$ = block_end($1,$2,$3); } + { if (copline > (line_t)$1) + copline = $1; + $$ = block_end($2, $3); } ; remember: /* NULL */ /* start a full lexical scope */ @@ -101,7 +103,9 @@ remember: /* NULL */ /* start a full lexical scope */ ; mblock : '{' mremember lineseq '}' - { $$ = block_end($1,$2,$3); } + { if (copline > (line_t)$1) + copline = $1; + $$ = block_end($2, $3); } ; mremember: /* NULL */ /* start a partial lexical scope */ @@ -163,11 +167,11 @@ else : /* NULL */ cond : IF '(' remember mexpr ')' mblock else { copline = $1; - $$ = block_end($1, $3, + $$ = block_end($3, newCONDOP(0, $4, scope($6), $7)); } | UNLESS '(' remember miexpr ')' mblock else { copline = $1; - $$ = block_end($1, $3, + $$ = block_end($3, newCONDOP(0, $4, scope($6), $7)); } | IF block block else { copline = $1; @@ -188,13 +192,13 @@ cont : /* NULL */ loop : label WHILE '(' remember mtexpr ')' mblock cont { copline = $2; - $$ = block_end($2, $4, + $$ = block_end($4, newSTATEOP(0, $1, newWHILEOP(0, 1, (LOOP*)Nullop, $5, $7, $8))); } | label UNTIL '(' remember miexpr ')' mblock cont { copline = $2; - $$ = block_end($2, $4, + $$ = block_end($4, newSTATEOP(0, $1, newWHILEOP(0, 1, (LOOP*)Nullop, $5, $7, $8))); } @@ -208,19 +212,19 @@ loop : label WHILE '(' remember mtexpr ')' mblock cont invert(scalar(scope($3))), $4, $5); } | label FOR MY remember my_scalar '(' mexpr ')' mblock cont - { $$ = block_end($2, $4, + { $$ = block_end($4, newFOROP(0, $1, $2, $5, $7, $9, $10)); } | label FOR scalar '(' remember mexpr ')' mblock cont - { $$ = block_end($2, $5, + { $$ = block_end($5, newFOROP(0, $1, $2, mod($3, OP_ENTERLOOP), $6, $8, $9)); } | label FOR '(' remember mexpr ')' mblock cont - { $$ = block_end($2, $4, + { $$ = block_end($4, newFOROP(0, $1, $2, Nullop, $5, $7, $8)); } | label FOR '(' remember mnexpr ';' mtexpr ';' mnexpr ')' mblock /* basically fake up an initialize-while lineseq */ { copline = $2; - $$ = block_end($2, $4, + $$ = block_end($4, append_elem(OP_LINESEQ, scalar($5), newSTATEOP(0, $1, newWHILEOP(0, 1, (LOOP*)Nullop, diff --git a/pod/perldebug.pod b/pod/perldebug.pod index f77bc92..f9dd6f4 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -62,7 +62,7 @@ it's run through your pager, as in =item p expr -Same as C in the current package. In particular, +Same as C in the current package. In particular, since this is just Perl's own B function, this means that nested data structures and objects are not dumped, unlike with the C command. @@ -72,6 +72,8 @@ Evals its expression in list context and dumps out the result in a pretty-printed fashion. Nested data structures are printed out recursively, unlike the C function. +The details of printout are governed by multiple Cptions. + =item V [pkg [vars]] Display all (or some) variables in package (defaulting to the C
@@ -87,6 +89,8 @@ Use C<~pattern> and C for positive and negative regexps. Nested data structures are printed out in a legible fashion, unlike the C function. +The details of printout are governed by multiple Cptions. + =item X [vars] Same as C. @@ -110,10 +114,10 @@ of the next statement. Repeat last C or C command. -=item c [line] +=item c [line|sub] Continue, optionally inserting a one-time-only breakpoint -at the specified line. +at the specified line or subroutine. =item l @@ -162,7 +166,7 @@ Search backwards for pattern; final ? is optional. =item L -List all breakpoints and actions for the current file. +List all breakpoints and actions. =item S [[!]pattern] @@ -170,7 +174,7 @@ List subroutine names [not] matching pattern. =item t -Toggle trace mode. +Toggle trace mode (see also C Cption). =item t expr @@ -194,7 +198,20 @@ Trace through execution of expr. For example: main::foo((eval 168):2): main::bar((eval 170):2): 42 - DB<4> q + +or, with the Cption C set, + + DB<4> O f=2 + frame = '2' + DB<5> t print foo() * bar() + 3: foo() * bar() + entering main::foo + 2: sub foo { 14 }; + exited main::foo + entering main::bar + 2: sub bar { 3 }; + exited main::bar + 42 =item b [line] [condition] @@ -205,12 +222,21 @@ only if the condition is true. Breakpoints may only be set on lines that begin an executable statement. Conditions don't use B: b 237 $x > 30 + b 237 ++$count237 < 11 b 33 /pattern/i =item b subname [condition] Set a breakpoint at the first line of the named subroutine. +=item b postpone subname [condition] + +Set breakpoint at first line of subroutine after it is compiled. + +=item b load filename + +Set breakpoint at the first executed line of the file. + =item d [line] Delete a breakpoint at the specified line. If line is omitted, deletes @@ -276,6 +302,41 @@ Program to use for output of pager-piped commands (those beginning with a C<|> character.) By default, C<$ENV{PAGER}> will be used. +=item tkRunning + +Run Tk while prompting (with ReadLine). + +=item signalLevel, warnLevel, dieLevel + +Level of verbosity. + +=item AutoTrace + +Where to print all the breakable points in the executed program +(similar to C command, but can be put into C). + +=item LineInfo + +File or pipe to print line number info to. If it is a +pipe, then a short, "emacs like" message is used. + +=item C + +If 0, allows I the end of the script. + +=item C + +affects printing of return value after C command. + +=item C + +affects printing messages on entry and exit from subroutines. If +C is false, messages are printed on entry only. (Printing +on exit may be useful if interdispersed with other messages.) + +If C, arguments to functions are printed as well as the +context and caller info. + =back The following options affect what happens with C, C, and C @@ -307,26 +368,60 @@ Dump symbol tables of packages. Change style of string dump. -=item tkRunning +=back -Run Tk while prompting (with ReadLine). +During startup options are initialized from C<$ENV{PERLDB_OPTS}>. +You can put additional initialization options C, C, +C, and C there. + +Example rc file: -=item signalLevel, warnLevel. dieLevel + &parse_options("NonStop=1 LineInfo=db.out AutoTrace"); -Level of verbosity. +The script will run without human intervention, putting trace information +into the file I. (If you interrupt it, you would better reset +C to something "interactive"!) -=back +=over 12 -The option C affects printing of return value after C -command, The option C affects printing messages on entry and exit -from subroutines. If C is 1, messages are printed on entry only; -if it's set to more than that, they'll will be printed on exit as well, -which may be useful if interdispersed with other messages. +=item C -During startup options are initialized from $ENV{PERLDB_OPTS}. -You can put additional initialization options C, C, -C, and C there. Here's an example of using -the C<$ENV{PERLDB_OPTS}> variable: +The TTY to use for debugging I/O. + +=item noTTY + +If set, goes in C mode. On interrupt if TTY is not set uses the +value of C or "/tmp/perldbtty$$" to find TTY using +C. Current variant is to have the name of TTY in this +file. + +=item C + +If set, goes in C mode, and would not connect to a TTY. If +interrupt (or if control goes to debugger via explicit setting of +$DB::signal or $DB::single from the Perl script), connects to a TTY +specified by the C option at startup, or to a TTY found at +runtime using C module of your choice. + +This module should implement a method C which returns an object +with two methods: C and C, returning two filehandles to use +for debugging input and output correspondingly. Method C may +inspect an argument which is a value of C<$ENV{PERLDB_NOTTY}> at +startup, or is C<"/tmp/perldbtty$$"> otherwise. + +=item C + +If false, readline support in debugger is disabled, so you can debug +ReadLine applications. + +=item C + +If set, debugger goes into non-interactive mode until interrupted, or +programmatically by setting $DB::signal or $DB::single. + +=back + +Here's an example of using the C<$ENV{PERLDB_OPTS}> variable: $ PERLDB_OPTS="N f=2" perl -d myprogram @@ -334,20 +429,63 @@ will run the script C without human intervention, printing out the call tree with entry and exit points. Note that C is equivalent to C. Note also that at the moment when this documentation was written all the options to the debugger could -be uniquely abbreviated by the first letter. +be uniquely abbreviated by the first letter (with exception of +C options). -See "Debugger Internals" below for more details. +Other examples may include -=item E command + $ PERLDB_OPTS="N f A L=listing" perl -d myprogram -Set an action to happen before every debugger prompt. A multiline -command may be entered by backslashing the newlines. +- runs script non-interactively, printing info on each entry into a +subroutine and each executed line into the file F. (If you +interrupt it, you would better reset C to something +"interactive"!) + + + $ env "PERLDB_OPTS=R=0 TTY=/dev/ttyc" perl -d myprogram + +may be useful for debugging a program which uses C +itself. Do not forget detach shell from the TTY in the window which +corresponds to F, say, by issuing a command like + + $ sleep 1000000 + +See L<"Debugger Internals"> below for more details. + +=item E [ command ] + +Set an action (Perl command) to happen before every debugger prompt. +A multiline command may be entered by backslashing the newlines. If +C is missing, resets the list of actions. + +=item EE command + +Add an action (Perl command) to happen before every debugger prompt. +A multiline command may be entered by backslashing the newlines. =item E command -Set an action to happen after the prompt when you've just given a -command to return to executing the script. A multiline command may be -entered by backslashing the newlines. +Set an action (Perl command) to happen after the prompt when you've +just given a command to return to executing the script. A multiline +command may be entered by backslashing the newlines. If C is +missing, resets the list of actions. + +=item EE command + +Adds an action (Perl command) to happen after the prompt when you've +just given a command to return to executing the script. A multiline +command may be entered by backslashing the newlines. + +=item { [ command ] + +Set an action (debugger command) to happen before every debugger prompt. +A multiline command may be entered by backslashing the newlines. If +C is missing, resets the list of actions. + +=item {{ command + +Add an action (debugger command) to happen before every debugger prompt. +A multiline command may be entered by backslashing the newlines. =item ! number @@ -374,7 +512,12 @@ listed. If number is omitted, lists them all. =item q or ^D -Quit. ("quit" doesn't work for this.) +Quit. ("quit" doesn't work for this.) This is the only supported way +to exit the debugger, though typing C twice may do it too. + +Set an Cption C to 0 if you want to be able to I the end the script. You may also need to set C<$finished> to 0 at +some moment if you want to step through global destruction. =item R @@ -382,6 +525,10 @@ Restart the debugger by Bing a new session. It tries to maintain your history across this, but internal settings and command line options may be lost. +Currently the following setting are preserved: history, breakpoints +and actions, debugger Cptions and the following command-line +options: B<-w>, B<-I>, B<-e>. + =item |dbcmd Run debugger command, piping DB::OUT to current pager. @@ -423,7 +570,8 @@ the built-in B-like history mechanism, e.g. C would repeat command number 17. The number of angle brackets indicates the depth of the debugger. You could get more than one set of brackets, for example, if you'd already at a breakpoint and then printed out the result of a -function call that itself also has a breakpoint. +function call that itself also has a breakpoint, or you step into an +expression via C command. If you want to enter a multi-line command, such as a subroutine definition with several statements, you may escape the newline that would @@ -459,7 +607,9 @@ but from line 4. If you have any compile-time executable statements (code within a BEGIN block or a C statement), these will C be stopped by debugger, -although Cs will. From your own Perl code, however, you can +although Cs will (and compile-time statements can be traced +with C option set in C). From your own Perl +code, however, you can transfer control back to the debugger using the following statement, which is harmless if the debugger is not running: @@ -472,11 +622,10 @@ having typed the C command. =head2 Debugger Customization -If you want to modify the debugger, copy F from the Perl -library to another name and modify it as necessary. You'll also want -to set your PERL5DB environment variable to say something like this: - - BEGIN { require "myperl5db.pl" } +Most probably you not want to modify the debugger, it contains enough +hooks to satisfy most needs. You may change the behaviour of debugger +from the debugger itself, using Cptions, from the command line via +C environment variable, and from I. You can do some customization by setting up a F<.perldb> file which contains initialization code. For instance, you could make aliases @@ -487,6 +636,25 @@ like these (the last one is one people expect to be there): $DB::alias{'ps'} = 's/^ps\b/p scalar /'; $DB::alias{'quit'} = 's/^quit(\s*)/exit\$/'; +One changes options from F<.perldb> file via calls like this one; + + parse_options("NonStop=1 LineInfo=db.out AutoTrace=1 frame=2"); + +(the code is executed in the package C). Note that F<.perldb> is +processed before processing C. If F<.perldb> defines the +subroutine C, it is called after all the debugger +initialization ends. F<.perldb> may be contained in the current +directory, or in the C/C directory. + +If you want to modify the debugger, copy F from the Perl +library to another name and modify it as necessary. You'll also want +to set your C environment variable to say something like this: + + BEGIN { require "myperl5db.pl" } + +As the last resort, one can use C to customize debugger by +directly setting internal variables or calling debugger functions. + =head2 Readline Support As shipped, the only command line history supplied is a simplistic one @@ -529,83 +697,134 @@ to a file called F. A tool like B (also supplied with the Devel::DProf package) can be used to interpret the information which is in that profile. -=head2 Debugger Internals +=head2 Debugger support in perl When you call the B function from package DB, Perl sets the C<@DB::args> array to contain the arguments that stack frame was called -with. It also maintains other magical internal variables, such as -C<@DB::dbline>, an array of the source code lines for the currently -selected (with the debugger's C command) file. Perl effectively -inserts a call to the function C(I) in front of every -place that can have a breakpoint. Instead of a subroutine call it calls -C setting C<$DB::sub> being the called subroutine. It also -inserts a C before the first line. +with. -Note that no subroutine call is possible until C<&DB::sub> is defined -(for subroutines defined outside this file). In fact, the same is -true if C<$DB::deep> (how many levels of recursion deep into the -debugger you are) is not defined. +If perl is run with B<-d> option, the following additional features +are enabled: -At the start, the debugger reads your rc file (F<./.perldb> or -F<~/.perldb> under UNIX), which can set important options. This file may -define a subroutine C<&afterinit> to be executed after the debugger is -initialized. +=over -After the rc file is read, the debugger reads environment variable -PERLDB_OPTS and parses it as a rest of C line in debugger prompt. +=item * -The following options can only be specified at startup. To set them in -your rc file, call C<&parse_options("optionName=new_value")>. +Perl inserts the contents of C<$ENV{PERL5DB}> (or C if not present) before the first line of the +application. -=over 12 +=item * -=item TTY +The array C<@{"_<$filename"}> is the line-by-line contents of +$filename for all the compiled files. Same for Ced strings which +contain subroutines, or which are currently executed. The C<$filename> +for Ced strings looks like C<(eval 34)>. -The TTY to use for debugging I/O. +=item * -=item noTTY +The hash C<%{"_<$filename"}> contains breakpoints and action (it is +keyed by line number), and individual entries are settable (as opposed +to the whole hash). Only true/false is important to Perl, though the +values used by F have the form +C<"$break_condition\0$action">. Values are magical in numeric context: +they are zeros if the line is not breakable. -If set, goes in C mode. On interrupt if TTY is not set uses the -value of C or "/tmp/perldbtty$$" to find TTY using -C. Current variant is to have the name of TTY in this -file. +Same for evaluated strings which contain subroutines, or which are +currently executed. The C<$filename> for Ced strings looks like +C<(eval 34)>. -=item ReadLine +=item * -If false, dummy ReadLine is used, so you can debug -ReadLine applications. +The scalar C<${"_<$filename"}> contains C<"_<$filename">. Same for +evaluated strings which contain subroutines, or which are currently +executed. The C<$filename> for Ced strings looks like C<(eval +34)>. -=item NonStop +=item * -If true, no I/O is performed until an interrupt. +After each Cd file is compiled, but before it is executed, +C is called (if subroutine +C exists). Here the $filename is the expanded name of +the Cd file (as found in values of C<%INC>). -=item LineInfo +=item * -File or pipe to print line number info to. If it is a -pipe, then a short, "emacs like" message is used. +After each subroutine C is compiled existence of +C<$DB::postponed{subname}> is checked. If this key exists, +C is called (if subroutine C +exists). -Example rc file: +=item * - &parse_options("NonStop=1 LineInfo=db.out"); - sub afterinit { $trace = 1; } +A hash C<%DB::sub> is maintained, with keys being subroutine names, +values having the form C. C has +the form C<(eval 31)> for subroutines defined inside Cs. -The script will run without human intervention, putting trace information -into the file I. (If you interrupt it, you would better reset -C to something "interactive"!) +=item * + +When an exection of the application reaches a place that can have a +breakpoint, a call to C is performed if any one of +variables $DB::trace, $DB::single, $DB::signal is true. (Note that +these variables are not Cizable.) This feature is disabled when +the control is inside C or functions called from it (unless +C<$^D & 1 EE 30>). + +=item * + +When an exection of the application reaches a subroutine call, a call +to C<&DB::sub>(I) is performed instead, with C<$DB::sub> being +the name of the called subroutine. (Unless the subroutine is compiled +in the package C.) =back +Note that no subroutine call is possible until C<&DB::sub> is defined +(for subroutines outside of package C). (In fact, for the +standard debugger the same is true if C<$DB::deep> (how many levels of +recursion deep into the debugger you can go before a mandatory break) +is not defined.) + +=head2 Debugger Internals + +At the start, the debugger reads your rc file (F<./.perldb> or +F<~/.perldb> under UNIX), which can set important options. This file may +define a subroutine C<&afterinit> to be executed after the debugger is +initialized. + +After the rc file is read, the debugger reads environment variable +PERLDB_OPTS and parses it as a rest of C line in debugger prompt. + +It also maintains magical internal variables, such as C<@DB::dbline>, +C<%DB::dbline>, which are aliases for C<@{"::_ +C<%{"::_. Here C is the currently +selected (with the debugger's C command, or by flow of execution) +file. + +Some functions are provided to simplify customization. See L<"Debugger +Customization"> for description of C. The +function C skips the specified number +of frames, and returns an array containing info about the caller +frames (all if C is missing). Each entry is a hash with keys +C (C<$> or C<@>), C (subroutine name, or info about +eval), C (C or a reference to an array), C and +C. + +The function C prints +formatted info about caller frames. The last two functions may be +convenient as arguments to C>, CE> commands. + =head2 Other resources You did try the B<-w> switch, didn't you? =head1 BUGS -If your program exit()s or die()s, so too does the debugger. - You cannot get the stack frame information or otherwise debug functions that were not compiled by Perl, such as C or C++ extensions. If you alter your @_ arguments in a subroutine (such as with B or B, the stack backtrace will not show the original values. +Some subroutines are called without creating a call frame. This may +confuse backtrace C and output of C=4>. diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index ba45e55..35f840f 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -341,7 +341,9 @@ restart system calls on some systems. Using eval/die always works. eval { local $SIG{ALRM} = sub { die "alarm\n" }; # NB \n required + alarm $timeout; $nread = sysread SOCKET, $buffer, $size; + alarm 0; }; die if $@ && $@ ne "alarm\n"; # propagate errors if ($@) { diff --git a/pod/perlobj.pod b/pod/perlobj.pod index d504d9c..691ce8b 100644 --- a/pod/perlobj.pod +++ b/pod/perlobj.pod @@ -305,10 +305,9 @@ less that the given argument. This method is normally called as a class method. This method is also called when the C form of C is used. - use A 1.2 qw(some imported subs); - A->require_version( 1.2 ); + A->VERSION( 1.2 ); =item class () diff --git a/pod/perlref.pod b/pod/perlref.pod index 18e3553..5303c3a 100644 --- a/pod/perlref.pod +++ b/pod/perlref.pod @@ -55,9 +55,9 @@ reference that the backslash returned. Here are some examples: $coderef = \&handler; $globref = \*foo; -It isn't possible to create a reference to a filehandle using the -backslash operator. See the explanation of the *foo{THING} syntax -below. +It isn't possible to create a reference to an IO handle (filehandle or +dirhandle) using the backslash operator. See the explanation of the +*foo{THING} syntax below. =item 2. @@ -200,26 +200,32 @@ known as foo). $arrayref = *ARGV{ARRAY}; $hashref = *ENV{HASH}; $coderef = *handler{CODE}; - $fhref = *STDIN{FILEHANDLE}; + $ioref = *STDIN{IO}; $globref = *foo{GLOB}; -Using *foo{FILEHANDLE} is the best way to pass filehandles into or out -of subroutines, or to store them in larger data structures. +All of these are self-explanatory except for *foo{IO}. It returns the +IO handle, used for file handles (L), sockets +(L and L), and directory handles +(L). For compatibility with previous versions of +Perl, *foo{FILEHANDLE} is a synonym for *foo{IO}. - splutter(*STDOUT{FILEHANDLE}); +The use of *foo{IO} is the best way to pass bareword filehandles into +or out of subroutines, or to store them in larger data structures. + + splutter(*STDOUT{IO}); sub splutter { my $fh = shift; print $fh "her um well a hmmm\n"; } - $rec = get_rec(*STDIN{FILEHANDLE}); + $rec = get_rec(*STDIN{IO}); sub get_rec { my $fh = shift; return scalar <$fh>; } The best way to do this used to be to use the entire *foo typeglob (or a -reference to it), so you'll probably come accross old code which does it +reference to it), so you'll probably come across old code which does it that way. =back @@ -265,7 +271,7 @@ previous examples could be written like this: ${$arrayref}[0] = "January"; ${$hashref}{"KEY"} = "VALUE"; &{$coderef}(1,2,3); - $globref->print("output\n"); # iff you use FileHandle + $globref->print("output\n"); # iff IO::Handle is loaded Admittedly, it's a little silly to use the curlies in this case, but the BLOCK can contain any arbitrary expression, in particular, diff --git a/pp.c b/pp.c index 48ca9bb..4663466 100644 --- a/pp.c +++ b/pp.c @@ -15,6 +15,20 @@ #include "EXTERN.h" #include "perl.h" +/* + * Types used in bitwise operations. + * + * Normally we'd just use IV and UV. However, some hardware and + * software combinations (e.g. Alpha and current OSF/1) don't have a + * floating-point type to use for NV that has adequate bits to fully + * hold an IV/UV. (In other words, sizeof(long) == sizeof(double).) + * + * It just so happens that "int" is the right size everywhere, at + * least today. + */ +typedef int IBW; +typedef unsigned UBW; + static void doencodes _((SV *sv, char *s, I32 len)); /* variations on pp_null */ @@ -672,19 +686,26 @@ PP(pp_modulo) { dSP; dATARGET; tryAMAGICbin(mod,opASSIGN); { - register IV value; - register UV uval; + register UV right; - uval = POPn; - if (!uval) + right = POPu; + if (!right) DIE("Illegal modulus zero"); - value = TOPn; - if (value >= 0) - value = (UV)value % uval; + + if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) { + register IV left = SvIVX(TOPs); + if (left < 0) + SETu( (right - ((UV)(-left) - 1) % right) - 1 ); + else + SETi( left % right ); + } else { - value = (uval - ((UV)(-value - 1) % uval)) - 1; + register double left = TOPn; + if (left < 0.0) + SETu( (right - (U_V(-left) - 1) % right) - 1 ); + else + SETu( U_V(left) % right ); } - SETi(value); RETURN; } } @@ -758,13 +779,13 @@ PP(pp_left_shift) { dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); { - IV shift = POPi; + IBW shift = POPi; if (op->op_private & HINT_INTEGER) { - IV i = TOPi; + IBW i = TOPi; SETi( i << shift ); } else { - UV u = TOPu; + UBW u = TOPu; SETu( u << shift ); } RETURN; @@ -775,13 +796,13 @@ PP(pp_right_shift) { dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); { - IV shift = POPi; + IBW shift = POPi; if (op->op_private & HINT_INTEGER) { - IV i = TOPi; + IBW i = TOPi; SETi( i >> shift ); } else { - UV u = TOPu; + UBW u = TOPu; SETu( u >> shift ); } RETURN; @@ -908,15 +929,22 @@ PP(pp_sge) } } +PP(pp_seq) +{ + dSP; tryAMAGICbinSET(seq,0); + { + dPOPTOPssrl; + SETs( sv_eq(left, right) ? &sv_yes : &sv_no ); + RETURN; + } +} + PP(pp_sne) { dSP; tryAMAGICbinSET(sne,0); { dPOPTOPssrl; - bool ne = ((op->op_private & OPpLOCALE) - ? (sv_cmp_locale(left, right) != 0) - : !sv_eq(left, right)); - SETs( ne ? &sv_yes : &sv_no ); + SETs( !sv_eq(left, right) ? &sv_yes : &sv_no ); RETURN; } } @@ -940,11 +968,14 @@ PP(pp_bit_and) { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { - UV value = SvUV(left) & SvUV(right); - if (op->op_private & HINT_INTEGER) - SETi( (IV)value ); - else + if (op->op_private & HINT_INTEGER) { + IBW value = SvIV(left) & SvIV(right); + SETi( value ); + } + else { + UBW value = SvUV(left) & SvUV(right); SETu( value ); + } } else { do_vop(op->op_type, TARG, left, right); @@ -960,11 +991,14 @@ PP(pp_bit_xor) { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { - UV value = SvUV(left) ^ SvUV(right); - if (op->op_private & HINT_INTEGER) - SETi( (IV)value ); - else + if (op->op_private & HINT_INTEGER) { + IBW value = SvIV(left) ^ SvIV(right); + SETi( value ); + } + else { + UBW value = SvUV(left) ^ SvUV(right); SETu( value ); + } } else { do_vop(op->op_type, TARG, left, right); @@ -980,11 +1014,14 @@ PP(pp_bit_or) { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { - UV value = SvUV(left) | SvUV(right); - if (op->op_private & HINT_INTEGER) - SETi( (IV)value ); - else + if (op->op_private & HINT_INTEGER) { + IBW value = SvIV(left) | SvIV(right); + SETi( value ); + } + else { + UBW value = SvUV(left) | SvUV(right); SETu( value ); + } } else { do_vop(op->op_type, TARG, left, right); @@ -1041,11 +1078,14 @@ PP(pp_complement) { dTOPss; if (SvNIOKp(sv)) { - UV value = ~SvUV(sv); - if (op->op_private & HINT_INTEGER) - SETi( (IV)value ); - else + if (op->op_private & HINT_INTEGER) { + IBW value = ~SvIV(sv); + SETi( value ); + } + else { + UBW value = ~SvUV(sv); SETu( value ); + } } else { register char *tmps; @@ -1332,7 +1372,7 @@ PP(pp_log) double value; value = POPn; if (value <= 0.0) { - NUMERIC_STANDARD(); + SET_NUMERIC_STANDARD(); DIE("Can't take log of %g", value); } value = log(value); @@ -1348,7 +1388,7 @@ PP(pp_sqrt) double value; value = POPn; if (value < 0.0) { - NUMERIC_STANDARD(); + SET_NUMERIC_STANDARD(); DIE("Can't take sqrt of %g", value); } value = sqrt(value); @@ -1637,12 +1677,12 @@ PP(pp_rindex) PP(pp_sprintf) { dSP; dMARK; dORIGMARK; dTARGET; -#ifdef LC_NUMERIC +#ifdef USE_LOCALE_NUMERIC if (op->op_private & OPpLOCALE) - NUMERIC_LOCAL(); + SET_NUMERIC_LOCAL(); else - NUMERIC_STANDARD(); -#endif /* LC_NUMERIC */ + SET_NUMERIC_STANDARD(); +#endif do_sprintf(TARG, SP-MARK, MARK+1); TAINT_IF(SvTAINTED(TARG)); SP = ORIGMARK; @@ -2160,15 +2200,19 @@ PP(pp_splice) Copy(AvARRAY(ary)+offset, MARK, length, SV*); if (AvREAL(ary)) { EXTEND_MORTAL(length); - for (i = length, dst = MARK; i; i--) - sv_2mortal(*dst++); /* free them eventualy */ + for (i = length, dst = MARK; i; i--) { + if (!SvIMMORTAL(*dst)) + sv_2mortal(*dst); /* free them eventualy */ + dst++; + } } MARK += length - 1; } else { *MARK = AvARRAY(ary)[offset+length-1]; if (AvREAL(ary)) { - sv_2mortal(*MARK); + if (!SvIMMORTAL(*MARK)) + sv_2mortal(*MARK); for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--) SvREFCNT_dec(*dst++); /* free them now */ } @@ -2255,8 +2299,11 @@ PP(pp_splice) Copy(tmparyval, MARK, length, SV*); if (AvREAL(ary)) { EXTEND_MORTAL(length); - for (i = length, dst = MARK; i; i--) - sv_2mortal(*dst++); /* free them eventualy */ + for (i = length, dst = MARK; i; i--) { + if (!SvIMMORTAL(*dst)) + sv_2mortal(*dst); /* free them eventualy */ + dst++; + } } Safefree(tmparyval); } @@ -2265,7 +2312,8 @@ PP(pp_splice) else if (length--) { *MARK = tmparyval[length]; if (AvREAL(ary)) { - sv_2mortal(*MARK); + if (!SvIMMORTAL(*MARK)) + sv_2mortal(*MARK); while (length-- > 0) SvREFCNT_dec(tmparyval[length]); } @@ -2300,7 +2348,7 @@ PP(pp_pop) dSP; AV *av = (AV*)POPs; SV *sv = av_pop(av); - if (sv != &sv_undef && AvREAL(av)) + if (!SvIMMORTAL(sv) && AvREAL(av)) (void)sv_2mortal(sv); PUSHs(sv); RETURN; @@ -2314,7 +2362,7 @@ PP(pp_shift) EXTEND(SP, 1); if (!sv) RETPUSHUNDEF; - if (sv != &sv_undef && AvREAL(av)) + if (!SvIMMORTAL(sv) && AvREAL(av)) (void)sv_2mortal(sv); PUSHs(sv); RETURN; @@ -2416,6 +2464,7 @@ PP(pp_unpack) { dSP; dPOPPOPssrl; + SV **oldsp = sp; SV *sv; STRLEN llen; STRLEN rlen; @@ -3090,6 +3139,8 @@ PP(pp_unpack) checksum = 0; } } + if (sp == oldsp && GIMME != G_ARRAY) + PUSHs(&sv_undef); RETURN; } diff --git a/pp_ctl.c b/pp_ctl.c index 8a38214..962cf04 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -378,7 +378,7 @@ PP(pp_formline) gotsome = TRUE; value = SvNV(sv); /* Formats aren't yet marked for locales, so assume "yes". */ - NUMERIC_LOCAL(); + SET_NUMERIC_LOCAL(); if (arg & 256) { sprintf(t, "%#*.*f", (int) fieldsize, (int) arg & 255, value); } else { @@ -906,61 +906,6 @@ I32 cxix; } } -#ifdef I_STDARG -OP * -die(char* pat, ...) -#else -/*VARARGS0*/ -OP * -die(pat, va_alist) - char *pat; - va_dcl -#endif -{ - va_list args; - char *message; - int oldrunlevel = runlevel; - int was_in_eval = in_eval; - HV *stash; - GV *gv; - CV *cv; - - /* We have to switch back to mainstack or die_where may try to pop - * the eval block from the wrong stack if die is being called from a - * signal handler. - dkindred@cs.cmu.edu */ - if (curstack != mainstack) { - dSP; - SWITCHSTACK(curstack, mainstack); - } - -#ifdef I_STDARG - va_start(args, pat); -#else - va_start(args); -#endif - message = mess(pat, &args); - va_end(args); - - if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) { - dSP; - SV *msg = sv_2mortal(newSVpv(message, 0)); - - PUSHMARK(sp); - EXTEND(sp, 1); - PUSHs(msg); - PUTBACK; - perl_call_sv((SV*)cv, G_DISCARD); - - /* It's okay for the __DIE__ hook to modify the message. */ - message = SvPV(msg, na); - } - - restartop = die_where(message); - if ((!restartop && was_in_eval) || oldrunlevel > 1) - Siglongjmp(top_env, 3); - return restartop; -} - OP * die_where(message) char *message; @@ -2078,7 +2023,7 @@ PP(pp_require) sv = POPs; if (SvNIOKp(sv) && !SvPOKp(sv)) { - NUMERIC_STANDARD(); + SET_NUMERIC_STANDARD(); if (atof(patchlevel) + 0.00000999 < SvNV(sv)) DIE("Perl %s required--this is only version %s, stopped", SvPV(sv,na),patchlevel); diff --git a/pp_hot.c b/pp_hot.c index 6fd0441..4b9ba00 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -100,7 +100,7 @@ PP(pp_gelem) ref = (SV*)GvCV(gv); break; case 'F': - if (strEQ(elem, "FILEHANDLE")) + if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */ ref = (SV*)GvIOp(gv); break; case 'G': @@ -111,6 +111,10 @@ PP(pp_gelem) if (strEQ(elem, "HASH")) ref = (SV*)GvHV(gv); break; + case 'I': + if (strEQ(elem, "IO")) + ref = (SV*)GvIOp(gv); + break; case 'N': if (strEQ(elem, "NAME")) sv = newSVpv(GvNAME(gv), GvNAMELEN(gv)); @@ -182,19 +186,6 @@ PP(pp_unstack) return NORMAL; } -PP(pp_seq) -{ - dSP; tryAMAGICbinSET(seq,0); - { - dPOPTOPssrl; - bool eq = ((op->op_private & OPpLOCALE) - ? (sv_cmp_locale(left, right) == 0) - : sv_eq(left, right)); - SETs( eq ? &sv_yes : &sv_no ); - RETURN; - } -} - PP(pp_concat) { dSP; dATARGET; tryAMAGICbin(concat,opASSIGN); @@ -835,7 +826,7 @@ play_it_again: else if (!multiline) { if (*SvPVX(pm->op_pmshort) != *s || (pm->op_pmslen > 1 - && memcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen))) + && memNE(SvPVX(pm->op_pmshort), s, pm->op_pmslen))) goto nope; } if (!rx->naughty && --BmUSEFUL(pm->op_pmshort) < 0) { @@ -1408,7 +1399,7 @@ PP(pp_subst) else if (!multiline) { if (*SvPVX(pm->op_pmshort) != *s || (pm->op_pmslen > 1 - && memcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen))) + && memNE(SvPVX(pm->op_pmshort), s, pm->op_pmslen))) goto nope; } if (!rx->naughty && --BmUSEFUL(pm->op_pmshort) < 0) { diff --git a/pp_sys.c b/pp_sys.c index 8af0072..9b30adb 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -102,6 +102,14 @@ static int dooneliner _((char *cmd, char *filename)); # define FLOCK flock #else /* no flock() */ + /* fcntl.h might not have been included, even if it exists, because + the current Configure only sets I_FCNTL if it's needed to pick up + the *_OK constants. Make sure it has been included before testing + the fcntl() locking constants. */ +# if defined(HAS_FCNTL) && !defined(I_FCNTL) +# include +# endif + # if defined(HAS_FCNTL) && defined(F_SETLK) && defined (F_SETLKW) # define FLOCK fcntl_emulate_flock # define FCNTL_EMULATE_FLOCK @@ -281,13 +289,11 @@ PP(pp_open) else DIE(no_usym, "filehandle"); gv = (GV*)POPs; - if (IoFLAGS(GvIOn(gv)) & IOf_UNTAINT) /* This GV has UNTAINT previously set */ - IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT; /* Clear it. We don't carry that over */ + if (GvIOp(gv)) + IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT; tmps = SvPV(sv, len); - if (do_open(gv, tmps, len, FALSE, 0, 0, Nullfp)) { - IoLINES(GvIOp(gv)) = 0; + if (do_open(gv, tmps, len, FALSE, 0, 0, Nullfp)) PUSHi( (I32)forkprocess ); - } else if (forkprocess == 0) /* we are a new child */ PUSHi(0); else @@ -1039,12 +1045,12 @@ PP(pp_prtf) goto just_say_no; } else { -#ifdef LC_NUMERIC +#ifdef USE_LOCALE_NUMERIC if (op->op_private & OPpLOCALE) - NUMERIC_LOCAL(); + SET_NUMERIC_LOCAL(); else - NUMERIC_STANDARD(); -#endif /* LC_NUMERIC */ + SET_NUMERIC_STANDARD(); +#endif do_sprintf(sv, SP - MARK, MARK + 1); if (!do_print(sv, fp)) goto just_say_no; @@ -1889,13 +1895,10 @@ PP(pp_stat) laststype = OP_STAT; statgv = tmpgv; sv_setpv(statname, ""); - if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) || - Fstat(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), &statcache) < 0) { - max = 0; - laststatval = -1; - } + laststatval = (GvIO(tmpgv) && IoIFP(GvIOp(tmpgv)) + ? Fstat(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), &statcache) : -1); } - else if (laststatval < 0) + if (laststatval < 0) max = 0; } else { @@ -1924,15 +1927,17 @@ PP(pp_stat) } } - EXTEND(SP, 13); - EXTEND_MORTAL(13); if (GIMME != G_ARRAY) { + EXTEND(SP, 1); if (max) RETPUSHYES; else RETPUSHUNDEF; } if (max) { + EXTEND(SP, max); + EXTEND_MORTAL(max); + PUSHs(sv_2mortal(newSViv((I32)statcache.st_dev))); PUSHs(sv_2mortal(newSViv((I32)statcache.st_ino))); PUSHs(sv_2mortal(newSViv((I32)statcache.st_mode))); @@ -3655,8 +3660,11 @@ PP(pp_gservent) } else if (which == OP_GSBYPORT) { char *proto = POPp; - int port = POPi; + unsigned short port = POPu; +#ifdef HAS_HTONS + port = htons(port); +#endif sent = getservbyport(port, proto); } else diff --git a/proto.h b/proto.h index b332373..787ebcf 100644 --- a/proto.h +++ b/proto.h @@ -28,7 +28,7 @@ SV** av_store _((AV* ar, I32 key, SV* val)); void av_undef _((AV* ar)); void av_unshift _((AV* ar, I32 num)); OP* bind_match _((I32 type, OP* left, OP* pat)); -OP* block_end _((int line, int floor, OP* seq)); +OP* block_end _((I32 floor, OP* seq)); int block_start _((int full)); void boot_core_UNIVERSAL _((void)); void calllist _((AV* list)); @@ -234,7 +234,7 @@ char* my_bzero _((char* loc, I32 len)); void my_exit _((U32 status)) __attribute__((noreturn)); I32 my_lstat _((void)); #ifndef HAS_MEMCMP -I32 my_memcmp _((unsigned char* s1, unsigned char* s2, I32 len)); +I32 my_memcmp _((char* s1, char* s2, I32 len)); #endif I32 my_pclose _((PerlIO* ptr)); PerlIO* my_popen _((char* cmd, char* mode)); @@ -329,8 +329,8 @@ int perl_init_i18nl14n _((int printwarn)); void perl_new_collate _((char *newcoll)); void perl_new_ctype _((char *newctype)); void perl_new_numeric _((char *newcoll)); -void perl_numeric_local _((void)); -void perl_numeric_standard _((void)); +void perl_set_numeric_local _((void)); +void perl_set_numeric_standard _((void)); int perl_parse _((PerlInterpreter* sv_interp, void(*xsinit)(void), int argc, char** argv, char** env)); void perl_require_pv _((char* pv)); #define perl_requirepv perl_require_pv diff --git a/regexec.c b/regexec.c index 0ea40dd..da3097e 100644 --- a/regexec.c +++ b/regexec.c @@ -709,7 +709,7 @@ char *prog; sayNO; if (regeol - locinput < ln) sayNO; - if (ln > 1 && memcmp(s, locinput, ln) != 0) + if (ln > 1 && memNE(s, locinput, ln)) sayNO; locinput += ln; nextchar = UCHARAT(locinput); @@ -833,7 +833,7 @@ char *prog; ln = regendp[n] - s; if (locinput + ln > regeol) sayNO; - if (ln > 1 && memcmp(s, locinput, ln) != 0) + if (ln > 1 && memNE(s, locinput, ln)) sayNO; locinput += ln; nextchar = UCHARAT(locinput); diff --git a/sv.c b/sv.c index 03d32a8..85c65bf 100644 --- a/sv.c +++ b/sv.c @@ -40,6 +40,8 @@ # define FAST_SV_GETS #endif +static IV asIV _((SV* sv)); +static UV asUV _((SV* sv)); static SV *more_sv _((void)); static XPVIV *more_xiv _((void)); static XPVNV *more_xnv _((void)); @@ -1001,7 +1003,7 @@ register SV *sv; sprintf(t,"(\"%.127s\")",SvPVX(sv)); } else if (SvNOKp(sv)) { - NUMERIC_STANDARD(); + SET_NUMERIC_STANDARD(); sprintf(t,"(%g)",SvNVX(sv)); } else if (SvIOKp(sv)) @@ -1248,14 +1250,10 @@ register SV *sv; else return (IV) U_V(SvNVX(sv)); } - if (SvPOKp(sv) && SvLEN(sv)) { - if (dowarn && !looks_like_number(sv)) - not_a_number(sv); - return (IV)atol(SvPVX(sv)); - } - if (!SvROK(sv)) { - return 0; - } + if (SvPOKp(sv) && SvLEN(sv)) + return asIV(sv); + if (!SvROK(sv)) + return 0; } if (SvTHINKFIRST(sv)) { if (SvROK(sv)) { @@ -1273,11 +1271,8 @@ register SV *sv; else return (IV) U_V(SvNVX(sv)); } - if (SvPOKp(sv) && SvLEN(sv)) { - if (dowarn && !looks_like_number(sv)) - not_a_number(sv); - return (IV)atol(SvPVX(sv)); - } + if (SvPOKp(sv) && SvLEN(sv)) + return asIV(sv); if (dowarn) warn(warn_uninit); return 0; @@ -1302,10 +1297,8 @@ register SV *sv; SvUVX(sv) = U_V(SvNVX(sv)); } else if (SvPOKp(sv) && SvLEN(sv)) { - if (dowarn && !looks_like_number(sv)) - not_a_number(sv); (void)SvIOK_on(sv); - SvIVX(sv) = (IV)atol(SvPVX(sv)); + SvIVX(sv) = asIV(sv); } else { if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) @@ -1329,14 +1322,10 @@ register SV *sv; return SvUVX(sv); if (SvNOKp(sv)) return U_V(SvNVX(sv)); - if (SvPOKp(sv) && SvLEN(sv)) { - if (dowarn && !looks_like_number(sv)) - not_a_number(sv); - return (UV)atol(SvPVX(sv)); - } - if (!SvROK(sv)) { - return 0; - } + if (SvPOKp(sv) && SvLEN(sv)) + return asUV(sv); + if (!SvROK(sv)) + return 0; } if (SvTHINKFIRST(sv)) { if (SvROK(sv)) { @@ -1351,11 +1340,8 @@ register SV *sv; if (SvNOKp(sv)) { return U_V(SvNVX(sv)); } - if (SvPOKp(sv) && SvLEN(sv)) { - if (dowarn && !looks_like_number(sv)) - not_a_number(sv); - return (UV)atol(SvPVX(sv)); - } + if (SvPOKp(sv) && SvLEN(sv)) + return asUV(sv); if (dowarn) warn(warn_uninit); return 0; @@ -1377,10 +1363,8 @@ register SV *sv; SvUVX(sv) = U_V(SvNVX(sv)); } else if (SvPOKp(sv) && SvLEN(sv)) { - if (dowarn && !looks_like_number(sv)) - not_a_number(sv); (void)SvIOK_on(sv); - SvUVX(sv) = (UV)atol(SvPVX(sv)); + SvUVX(sv) = asUV(sv); } else { if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) @@ -1405,7 +1389,7 @@ register SV *sv; if (SvPOKp(sv) && SvLEN(sv)) { if (dowarn && !SvIOKp(sv) && !looks_like_number(sv)) not_a_number(sv); - NUMERIC_STANDARD(); + SET_NUMERIC_STANDARD(); return atof(SvPVX(sv)); } if (SvIOKp(sv)) @@ -1427,7 +1411,7 @@ register SV *sv; if (SvPOKp(sv) && SvLEN(sv)) { if (dowarn && !SvIOKp(sv) && !looks_like_number(sv)) not_a_number(sv); - NUMERIC_STANDARD(); + SET_NUMERIC_STANDARD(); return atof(SvPVX(sv)); } if (SvIOKp(sv)) @@ -1442,7 +1426,7 @@ register SV *sv; sv_upgrade(sv, SVt_PVNV); else sv_upgrade(sv, SVt_NV); - DEBUG_c(NUMERIC_STANDARD()); + DEBUG_c(SET_NUMERIC_STANDARD()); DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx num(%g)\n",(unsigned long)sv,SvNVX(sv))); } @@ -1456,7 +1440,7 @@ register SV *sv; else if (SvPOKp(sv) && SvLEN(sv)) { if (dowarn && !SvIOKp(sv) && !looks_like_number(sv)) not_a_number(sv); - NUMERIC_STANDARD(); + SET_NUMERIC_STANDARD(); SvNVX(sv) = atof(SvPVX(sv)); } else { @@ -1465,12 +1449,103 @@ register SV *sv; return 0.0; } SvNOK_on(sv); - DEBUG_c(NUMERIC_STANDARD()); + DEBUG_c(SET_NUMERIC_STANDARD()); DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%g)\n",(unsigned long)sv,SvNVX(sv))); return SvNVX(sv); } +static IV +asIV(sv) +SV *sv; +{ + I32 numtype = looks_like_number(sv); + double d; + + if (numtype == 1) + return atol(SvPVX(sv)); + if (!numtype && dowarn) + not_a_number(sv); + SET_NUMERIC_STANDARD(); + d = atof(SvPVX(sv)); + if (d < 0.0) + return I_V(d); + else + return (IV) U_V(d); +} + +static UV +asUV(sv) +SV *sv; +{ + I32 numtype = looks_like_number(sv); + + if (numtype == 1) + return atol(SvPVX(sv)); + if (!numtype && dowarn) + not_a_number(sv); + SET_NUMERIC_STANDARD(); + return U_V(atof(SvPVX(sv))); +} + +I32 +looks_like_number(sv) +SV *sv; +{ + register char *s; + register char *send; + register char *sbegin; + I32 numtype = 1; + STRLEN len; + + if (SvPOK(sv)) { + sbegin = SvPVX(sv); + len = SvCUR(sv); + } + else if (SvPOKp(sv)) + sbegin = SvPV(sv, len); + else + return 1; + send = sbegin + len; + + s = sbegin; + while (isSPACE(*s)) + s++; + if (s >= send) + return 0; + if (*s == '+' || *s == '-') + s++; + while (isDIGIT(*s)) + s++; + if (s == send) + return numtype; + if (*s == '.') { + numtype = 1; + s++; + } + else if (s == SvPVX(sv)) + return 0; + while (isDIGIT(*s)) + s++; + if (s == send) + return numtype; + if (*s == 'e' || *s == 'E') { + numtype = 2; + s++; + if (*s == '+' || *s == '-') + s++; + while (isDIGIT(*s)) + s++; + } + while (isSPACE(*s)) + s++; + if (s >= send) + return numtype; + if (len == 10 && memEQ(sbegin, "0 but true", 10)) + return 1; + return 0; +} + char * sv_2pv(sv, lp) register SV *sv; @@ -1494,7 +1569,7 @@ STRLEN *lp; goto tokensave; } if (SvNOKp(sv)) { - NUMERIC_STANDARD(); + SET_NUMERIC_STANDARD(); Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf); goto tokensave; } @@ -1530,7 +1605,7 @@ STRLEN *lp; case SVt_PVCV: s = "CODE"; break; case SVt_PVGV: s = "GLOB"; break; case SVt_PVFM: s = "FORMATLINE"; break; - case SVt_PVIO: s = "FILEHANDLE"; break; + case SVt_PVIO: s = "IO"; break; default: s = "UNKNOWN"; break; } if (SvOBJECT(sv)) @@ -1545,7 +1620,7 @@ STRLEN *lp; } if (SvREADONLY(sv)) { if (SvNOKp(sv)) { - NUMERIC_STANDARD(); + SET_NUMERIC_STANDARD(); Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf); goto tokensave; } @@ -1573,7 +1648,7 @@ STRLEN *lp; else #endif /*apollo*/ { - NUMERIC_STANDARD(); + SET_NUMERIC_STANDARD(); Gconvert(SvNVX(sv), DBL_DIG, 0, s); } errno = olderrno; @@ -2280,11 +2355,11 @@ I32 namlen; case 'l': mg->mg_virtual = &vtbl_dbline; break; -#ifdef HAS_STRXFRM +#ifdef USE_LOCALE_COLLATE case 'o': mg->mg_virtual = &vtbl_collxfrm; break; -#endif +#endif /* USE_LOCALE_COLLATE */ case 'P': mg->mg_virtual = &vtbl_pack; break; @@ -2721,7 +2796,7 @@ register SV *str2; if (cur1 != cur2) return 0; - return !memcmp(pv1, pv2, cur1); + return memEQ(pv1, pv2, cur1); } I32 @@ -2757,7 +2832,7 @@ sv_cmp_locale(sv1, sv2) register SV *sv1; register SV *sv2; { -#ifdef LC_COLLATE +#ifdef USE_LOCALE_COLLATE char *pv1, *pv2; STRLEN len1, len2; @@ -2797,12 +2872,12 @@ register SV *sv2; raw_compare: /* FALL THROUGH */ -#endif /* LC_COLLATE */ +#endif /* USE_LOCALE_COLLATE */ return sv_cmp(sv1, sv2); } -#ifdef LC_COLLATE +#ifdef USE_LOCALE_COLLATE char * sv_collxfrm(sv, nxp) @@ -2811,8 +2886,8 @@ sv_collxfrm(sv, nxp) { /* Any scalar variable may carry an 'o' magic that contains the * scalar data of the variable transformed to such a format that - * a normal memcmp() can be used to compare the data according - * to the locale settings. */ + * a normal memory comparison can be used to compare the data + * according to the locale settings. */ MAGIC *mg = NULL; @@ -2846,7 +2921,7 @@ sv_collxfrm(sv, nxp) } } -#endif /* LC_COLLATE */ +#endif /* USE_LOCALE_COLLATE */ char * sv_gets(sv,fp,append) @@ -2961,7 +3036,7 @@ I32 append; } } else { - memcpy((char*)bp, (char*)ptr, cnt); /* this | eat */ + Copy(ptr, bp, cnt, char); /* this | eat */ bp += cnt; /* screams | dust */ ptr += cnt; /* louder | sed :-) */ cnt = 0; @@ -3017,7 +3092,7 @@ I32 append; thats_all_folks: if ((rslen > 1 && (bp - (STDCHAR*)SvPVX(sv) < rslen)) || - memcmp((char*)bp - rslen, rsptr, rslen)) + memNE((char*)bp - rslen, rsptr, rslen)) goto screamer; /* go back to the fray */ thats_really_all_folks: if (shortbuffered) @@ -3064,7 +3139,7 @@ screamer2: if (i != EOF && /* joy */ (!rslen || SvCUR(sv) < rslen || - memcmp(SvPVX(sv) + SvCUR(sv) - rslen, rsptr, rslen))) + memNE(SvPVX(sv) + SvCUR(sv) - rslen, rsptr, rslen))) { append = -1; goto screamer2; @@ -3132,7 +3207,7 @@ register SV *sv; while (isALPHA(*d)) d++; while (isDIGIT(*d)) d++; if (*d) { - NUMERIC_STANDARD(); + SET_NUMERIC_STANDARD(); sv_setnv(sv,atof(SvPVX(sv)) + 1.0); /* punt */ return; } @@ -3203,7 +3278,7 @@ register SV *sv; (void)SvNOK_only(sv); return; } - NUMERIC_STANDARD(); + SET_NUMERIC_STANDARD(); sv_setnv(sv,atof(SvPVX(sv)) - 1.0); /* punt */ } @@ -3845,18 +3920,23 @@ void sv_untaint(sv) SV *sv; { - MAGIC *mg = mg_find(sv, 't'); - if (mg) - mg->mg_len &= ~1; + if (SvMAGICAL(sv)) { + MAGIC *mg = mg_find(sv, 't'); + if (mg) + mg->mg_len &= ~1; + } } bool sv_tainted(sv) SV *sv; { - MAGIC *mg = mg_find(sv, 't'); - return (mg && ((mg->mg_len & 1) - || (mg->mg_len & 2) && mg->mg_obj == sv)); + if (SvMAGICAL(sv)) { + MAGIC *mg = mg_find(sv, 't'); + if (mg && ((mg->mg_len & 1) || (mg->mg_len & 2) && mg->mg_obj == sv)) + return TRUE; + } + return FALSE; } #ifdef DEBUGGING @@ -4002,7 +4082,7 @@ SV* sv; if (type >= SVt_PVIV || type == SVt_IV) PerlIO_printf(Perl_debug_log, " IV = %ld\n", (long)SvIVX(sv)); if (type >= SVt_PVNV || type == SVt_NV) { - NUMERIC_STANDARD(); + SET_NUMERIC_STANDARD(); PerlIO_printf(Perl_debug_log, " NV = %.*g\n", DBL_DIG, SvNVX(sv)); } if (SvROK(sv)) { diff --git a/sv.h b/sv.h index 06bf356..d90e85e 100644 --- a/sv.h +++ b/sv.h @@ -557,6 +557,8 @@ I32 SvTRUE _((SV *)); #define SvPEEK(sv) sv_peek(sv) +#define SvIMMORTAL(sv) ((sv)==&sv_undef || (sv)==&sv_yes || (sv)==&sv_no) + #define isGV(sv) (SvTYPE(sv) == SVt_PVGV) #ifndef DOSISH diff --git a/t/base/term.t b/t/base/term.t index 7bbb80e..782ad39 100755 --- a/t/base/term.t +++ b/t/base/term.t @@ -2,7 +2,7 @@ # $RCSfile: term.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:07 $ -print "1..6\n"; +print "1..7\n"; # check "" interpretation @@ -27,16 +27,19 @@ if ($#x == '1') {print "ok 3\n";} else {print "not ok 3\n";} $x = 1; if ($x == '1') {print "ok 4\n";} else {print "not ok 4\n";} +$x = '1E2'; +if (($x | 1) == 101) {print "ok 5\n";} else {print "not ok 5\n";} + # check <> pseudoliteral open(try, "/dev/null") || open(try,"nla0:") || (die "Can't open /dev/null."); if ( eq '') { - print "ok 5\n"; + print "ok 6\n"; } else { - print "not ok 5\n"; + print "not ok 6\n"; die "/dev/null IS NOT A CHARACTER SPECIAL FILE!!!!\n" unless -c '/dev/null'; } open(try, "../Configure") || (die "Can't open ../Configure."); -if ( ne '') {print "ok 6\n";} else {print "not ok 6\n";} +if ( ne '') {print "ok 7\n";} else {print "not ok 7\n";} diff --git a/t/lib/db-btree.t b/t/lib/db-btree.t index e20cfab..7dea2ed 100755 --- a/t/lib/db-btree.t +++ b/t/lib/db-btree.t @@ -429,13 +429,13 @@ $Dfile1 = "btree1" ; $Dfile2 = "btree2" ; $Dfile3 = "btree3" ; -$dbh1 = TIEHASH DB_File::BTREEINFO ; +$dbh1 = new DB_File::BTREEINFO ; $dbh1->{compare} = sub { $_[0] <=> $_[1] } ; -$dbh2 = TIEHASH DB_File::BTREEINFO ; +$dbh2 = new DB_File::BTREEINFO ; $dbh2->{compare} = sub { $_[0] cmp $_[1] } ; -$dbh3 = TIEHASH DB_File::BTREEINFO ; +$dbh3 = new DB_File::BTREEINFO ; $dbh3->{compare} = sub { length $_[0] <=> length $_[1] } ; diff --git a/t/lib/db-recno.t b/t/lib/db-recno.t index 9427a43..6027b6f 100755 --- a/t/lib/db-recno.t +++ b/t/lib/db-recno.t @@ -23,7 +23,7 @@ sub ok print "ok $no\n" ; } -print "1..47\n"; +print "1..55\n"; my $Dfile = "recno.tmp"; unlink $Dfile ; @@ -179,4 +179,70 @@ untie(@h); unlink $Dfile; +{ + # Check bval defaults to \n + + my @h = () ; + my $dbh = new DB_File::RECNOINFO ; + ok(48, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ; + $h[0] = "abc" ; + $h[1] = "def" ; + $h[3] = "ghi" ; + untie @h ; + my $x = `cat $Dfile` ; + ok(49, $x eq "abc\ndef\n\nghi\n") ; + unlink $Dfile; +} + +{ + # Change bval + + my @h = () ; + my $dbh = new DB_File::RECNOINFO ; + $dbh->{bval} = "-" ; + ok(50, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ; + $h[0] = "abc" ; + $h[1] = "def" ; + $h[3] = "ghi" ; + untie @h ; + my $x = `cat $Dfile` ; + ok(51, $x eq "abc-def--ghi-") ; + unlink $Dfile; +} + +{ + # Check R_FIXEDLEN with default bval (space) + + my @h = () ; + my $dbh = new DB_File::RECNOINFO ; + $dbh->{flags} = R_FIXEDLEN ; + $dbh->{reclen} = 5 ; + ok(52, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ; + $h[0] = "abc" ; + $h[1] = "def" ; + $h[3] = "ghi" ; + untie @h ; + my $x = `cat $Dfile` ; + ok(53, $x eq "abc def ghi ") ; + unlink $Dfile; +} + +{ + # Check R_FIXEDLEN with user-defined bval + + my @h = () ; + my $dbh = new DB_File::RECNOINFO ; + $dbh->{flags} = R_FIXEDLEN ; + $dbh->{bval} = "-" ; + $dbh->{reclen} = 5 ; + ok(54, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ; + $h[0] = "abc" ; + $h[1] = "def" ; + $h[3] = "ghi" ; + untie @h ; + my $x = `cat $Dfile` ; + ok(55, $x eq "abc--def-------ghi--") ; + unlink $Dfile; +} + exit ; diff --git a/t/lib/filehand.t b/t/lib/filehand.t index 0199a52..038a73c 100755 --- a/t/lib/filehand.t +++ b/t/lib/filehand.t @@ -4,7 +4,7 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require Config; import Config; - if ($Config{'extensions'} !~ /\bFileHandle\b/ && $^O ne 'VMS') { + if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') { print "1..0\n"; exit 0; } @@ -13,17 +13,63 @@ BEGIN { use FileHandle; use strict subs; +autoflush STDOUT 1; + $mystdout = new_from_fd FileHandle 1,"w"; $| = 1; autoflush $mystdout; -print "1..4\n"; +print "1..11\n"; print $mystdout "ok ",fileno($mystdout),"\n"; $fh = new FileHandle "TEST", O_RDONLY and print "ok 2\n"; + + $buffer = <$fh>; print $buffer eq "#!./perl\n" ? "ok 3\n" : "not ok 3\n"; + ungetc $fh 65; CORE::read($fh, $buf,1); print $buf eq 'A' ? "ok 4\n" : "not ok 4\n"; + +close $fh; + +$fh = new FileHandle; + +print "not " unless ($fh->open("< TEST") && <$fh> eq $buffer); +print "ok 5\n"; + +$fh->seek(0,0); +print "not " unless (<$fh> eq $buffer); +print "ok 6\n"; + +$fh->seek(0,2); +$line = <$fh>; +print "not " if (defined($line) || !$fh->eof); +print "ok 7\n"; + +print "not " unless ($fh->open("TEST","r") && !$fh->tell && $fh->close); +print "ok 8\n"; + +autoflush STDOUT 0; + +print "not " if ($|); +print "ok 9\n"; + +autoflush STDOUT 1; + +print "not " unless ($|); +print "ok 10\n"; + +($rd,$wr) = FileHandle::pipe; + +if (fork) { + $wr->close; + print $rd->getline; +} +else { + $rd->close; + $wr->printf("ok %d\n",11); + exit(0); +} diff --git a/t/lib/safe2.t b/t/lib/safe2.t index 61c6c8f..586eace 100755 --- a/t/lib/safe2.t +++ b/t/lib/safe2.t @@ -119,7 +119,8 @@ print $@ =~ /foo bar/ ? "ok 29\n" : "not ok 29\n"; my $t = 30; $cpt->rdo('/non/existant/file.name'); -print +(($! =~ /No such file/ || $! =~ /file specification syntax error/) ? +print +(($! =~ /No such file/ || $! =~ /file specification syntax error/) || + $! =~ /A file or directory in the path name does not exist/ ? "ok $t\n" : "not ok $t # $!\n"); $t++; print 1 ? "ok $t\n" : "not ok $t\n#$@/$!\n"; $t++; diff --git a/t/op/misc.t b/t/op/misc.t index e3bf576..024a514 100755 --- a/t/op/misc.t +++ b/t/op/misc.t @@ -37,6 +37,12 @@ for (@prgs){ } __END__ +$cusp = ~0 ^ (~0 >> 1); +$, = " "; +print +($cusp - 1) % 8, $cusp % 8, -$cusp % 8, ($cusp + 1) % 8, "!\n"; +EXPECT +7 0 0 1 ! +######## $foo=undef; $foo->go; EXPECT Can't call method "go" without a package or object reference at - line 1. diff --git a/toke.c b/toke.c index 7dd35cb..a73c6fb 100644 --- a/toke.c +++ b/toke.c @@ -1255,7 +1255,7 @@ yylex() /* Force them to make up their mind on "@foo". */ if (pit == '@' && lex_state != LEX_NORMAL && !lex_brackets) { GV *gv = gv_fetchpv(tokenbuf+1, FALSE, SVt_PVAV); - if (!gv || (tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)) { + if (!gv || ((tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv))) { char tmpbuf[1024]; sprintf(tmpbuf, "Literal %s now requires backslash", tokenbuf); yyerror(tmpbuf); @@ -4341,8 +4341,6 @@ char *start; pm = (PMOP*)newPMOP(OP_MATCH, 0); if (multi_open == '?') pm->op_pmflags |= PMf_ONCE; - if (hints & HINT_LOCALE) - pm->op_pmflags |= PMf_LOCALE; while (*s && strchr("iogmsx", *s)) pmflag(&pm->op_pmflags,*s++); pm->op_pmpermflags = pm->op_pmflags; @@ -4570,7 +4568,7 @@ register char *s; if (!rsfp) { d = s; while (s < bufend && - (*s != term || memcmp(s,tokenbuf,len) != 0) ) { + (*s != term || memNE(s,tokenbuf,len)) ) { if (*s++ == '\n') curcop->cop_line++; } @@ -4603,7 +4601,7 @@ register char *s; (I32)curcop->cop_line,sv); } bufend = SvPVX(linestr) + SvCUR(linestr); - if (*s == term && memcmp(s,tokenbuf,len) == 0) { + if (*s == term && memEQ(s,tokenbuf,len)) { s = bufend - 1; *s = ' '; sv_catsv(linestr,herewas); @@ -4882,7 +4880,7 @@ char *start; } *d = '\0'; sv = NEWSV(92,0); - NUMERIC_STANDARD(); + SET_NUMERIC_STANDARD(); value = atof(tokenbuf); tryi32 = I_32(value); if (!floatit && (double)tryi32 == value) diff --git a/util.c b/util.c index 6630b07..f5c7659 100644 --- a/util.c +++ b/util.c @@ -19,6 +19,10 @@ #include #endif +#ifndef SIG_ERR +# define SIG_ERR ((Sighandler_t) -1) +#endif + /* XXX If this causes problems, set i_unistd=undef in the hint file. */ #ifdef I_UNISTD # include @@ -400,8 +404,6 @@ char *lend; return Nullch; } -#ifdef LC_CTYPE - /* * Set up for a new ctype locale. */ @@ -409,6 +411,8 @@ void perl_new_ctype(newctype) char *newctype; { +#ifdef USE_LOCALE_CTYPE + int i; for (i = 0; i < 256; i++) { @@ -419,11 +423,9 @@ perl_new_ctype(newctype) else fold_locale[i] = i; } -} - -#endif /* LC_CTYPE */ -#ifdef LC_COLLATE +#endif /* USE_LOCALE_CTYPE */ +} /* * Set up for a new collation locale. @@ -432,16 +434,16 @@ void perl_new_collate(newcoll) char *newcoll; { +#ifdef USE_LOCALE_COLLATE + if (! newcoll) { if (collation_name) { ++collation_ix; Safefree(collation_name); collation_name = NULL; collation_standard = TRUE; -#ifdef HAS_STRXFRM collxfrm_base = 0; collxfrm_mult = 2; -#endif /* HAS_STRXFRM */ } return; } @@ -452,7 +454,6 @@ perl_new_collate(newcoll) collation_name = savepv(newcoll); collation_standard = (strEQ(newcoll, "C") || strEQ(newcoll, "POSIX")); -#ifdef HAS_STRXFRM { /* 2: at most so many chars ('a', 'b'). */ /* 50: surely no system expands a char more. */ @@ -466,13 +467,10 @@ perl_new_collate(newcoll) collxfrm_base = (fa > mult) ? (fa - mult) : 0; collxfrm_mult = mult; } -#endif /* HAS_STRXFRM */ } -} -#endif /* LC_COLLATE */ - -#ifdef LC_NUMERIC +#endif /* USE_LOCALE_COLLATE */ +} /* * Set up for a new numeric locale. @@ -481,6 +479,8 @@ void perl_new_numeric(newnum) char *newnum; { +#ifdef USE_LOCALE_NUMERIC + if (! newnum) { if (numeric_name) { Safefree(numeric_name); @@ -497,10 +497,14 @@ perl_new_numeric(newnum) numeric_standard = (strEQ(newnum, "C") || strEQ(newnum, "POSIX")); numeric_local = TRUE; } + +#endif /* USE_LOCALE_NUMERIC */ } +#ifdef USE_LOCALE_NUMERIC + void -perl_numeric_standard() +perl_set_numeric_standard() { if (! numeric_standard) { setlocale(LC_NUMERIC, "C"); @@ -510,7 +514,7 @@ perl_numeric_standard() } void -perl_numeric_local() +perl_set_numeric_local() { if (! numeric_local) { setlocale(LC_NUMERIC, numeric_name); @@ -519,9 +523,12 @@ perl_numeric_local() } } -#endif /* LC_NUMERIC */ +#endif /* USE_LOCALE_NUMERIC */ + -/* Initialize locale awareness */ +/* + * Initialize locale awareness. + */ int perl_init_i18nl10n(printwarn) int printwarn; @@ -533,22 +540,22 @@ perl_init_i18nl10n(printwarn) * -1 = fallback to C locale failed */ -#ifdef HAS_SETLOCALE +#ifdef USE_LOCALE char *lc_all = getenv("LC_ALL"); char *lang = getenv("LANG"); -#ifdef LC_CTYPE +#ifdef USE_LOCALE_CTYPE char *lc_ctype = getenv("LC_CTYPE"); char *curctype = NULL; -#endif /* LC_CTYPE */ -#ifdef LC_COLLATE +#endif /* USE_LOCALE_CTYPE */ +#ifdef USE_LOCALE_COLLATE char *lc_collate = getenv("LC_COLLATE"); char *curcoll = NULL; -#endif /* LC_COLLATE */ -#ifdef LC_NUMERIC +#endif /* USE_LOCALE_COLLATE */ +#ifdef USE_LOCALE_NUMERIC char *lc_numeric = getenv("LC_NUMERIC"); char *curnum = NULL; -#endif /* LC_NUMERIC */ +#endif /* USE_LOCALE_NUMERIC */ bool setlocale_failure = FALSE; char *subloc; @@ -560,18 +567,18 @@ perl_init_i18nl10n(printwarn) subloc = ""; #endif /* LC_ALL */ -#ifdef LC_CTYPE +#ifdef USE_LOCALE_CTYPE if (! (curctype = setlocale(LC_CTYPE, subloc))) setlocale_failure = TRUE; -#endif /* LC_CTYPE */ -#ifdef LC_COLLATE +#endif /* USE_LOCALE_CTYPE */ +#ifdef USE_LOCALE_COLLATE if (! (curcoll = setlocale(LC_COLLATE, subloc))) setlocale_failure = TRUE; -#endif /* LC_COLLATE */ -#ifdef LC_NUMERIC +#endif /* USE_LOCALE_COLLATE */ +#ifdef USE_LOCALE_NUMERIC if (! (curnum = setlocale(LC_NUMERIC, subloc))) setlocale_failure = TRUE; -#endif /* LC_NUMERIC */ +#endif /* USE_LOCALE_NUMERIC */ if (setlocale_failure && (lc_all || lang)) { char *perl_badlang; @@ -582,18 +589,18 @@ perl_init_i18nl10n(printwarn) PerlIO_printf(PerlIO_stderr(), "perl: warning: Setting locale failed for the categories:\n\t"); -#ifdef LC_CTYPE +#ifdef USE_LOCALE_CTYPE if (! curctype) - PerlIO_printf(PerlIO_stderr(), "LC_CTYPE "); -#endif /* LC_CTYPE */ -#ifdef LC_COLLATE + PerlIO_printf(PerlIO_stderr(), "USE_LOCALE_CTYPE "); +#endif /* USE_LOCALE_CTYPE */ +#ifdef USE_LOCALE_COLLATE if (! curcoll) - PerlIO_printf(PerlIO_stderr(), "LC_COLLATE "); -#endif /* LC_COLLATE */ -#ifdef LC_NUMERIC + PerlIO_printf(PerlIO_stderr(), "USE_LOCALE_COLLATE "); +#endif /* USE_LOCALE_COLLATE */ +#ifdef USE_LOCALE_NUMERIC if (! curnum) - PerlIO_printf(PerlIO_stderr(), "LC_NUMERIC "); -#endif /* LC_NUMERIC */ + PerlIO_printf(PerlIO_stderr(), "USE_LOCALE_NUMERIC "); +#endif /* USE_LOCALE_NUMERIC */ PerlIO_printf(PerlIO_stderr(), "\n"); PerlIO_printf(PerlIO_stderr(), @@ -604,30 +611,30 @@ perl_init_i18nl10n(printwarn) lc_all ? '"' : '(', lc_all ? lc_all : "unset", lc_all ? '"' : ')'); -#ifdef LC_CTYPE +#ifdef USE_LOCALE_CTYPE if (! curctype) PerlIO_printf(PerlIO_stderr(), "\tLC_CTYPE = %c%s%c,\n", lc_ctype ? '"' : '(', lc_ctype ? lc_ctype : "unset", lc_ctype ? '"' : ')'); -#endif /* LC_CTYPE */ -#ifdef LC_COLLATE +#endif /* USE_LOCALE_CTYPE */ +#ifdef USE_LOCALE_COLLATE if (! curcoll) PerlIO_printf(PerlIO_stderr(), "\tLC_COLLATE = %c%s%c,\n", lc_collate ? '"' : '(', lc_collate ? lc_collate : "unset", lc_collate ? '"' : ')'); -#endif /* LC_COLLATE */ -#ifdef LC_NUMERIC - if (! curcoll) +#endif /* USE_LOCALE_COLLATE */ +#ifdef USE_LOCALE_NUMERIC + if (! curnum) PerlIO_printf(PerlIO_stderr(), "\tLC_NUMERIC = %c%s%c,\n", lc_numeric ? '"' : '(', lc_numeric ? lc_numeric : "unset", lc_numeric ? '"' : ')'); -#endif /* LC_NUMERIC */ +#endif /* USE_LOCALE_NUMERIC */ PerlIO_printf(PerlIO_stderr(), "\tLANG = %c%s%c\n", lang ? '"' : ')', @@ -645,15 +652,15 @@ perl_init_i18nl10n(printwarn) PerlIO_printf(PerlIO_stderr(), "perl: warning: Falling back to the \"C\" locale.\n"); if (setlocale(LC_ALL, "C")) { -#ifdef LC_CTYPE +#ifdef USE_LOCALE_CTYPE curctype = "C"; -#endif /* LC_CTYPE */ -#ifdef LC_COLLATE +#endif /* USE_LOCALE_CTYPE */ +#ifdef USE_LOCALE_COLLATE curcoll = "C"; -#endif /* LC_COLLATE */ -#ifdef LC_NUMERIC +#endif /* USE_LOCALE_COLLATE */ +#ifdef USE_LOCALE_NUMERIC curnum = "C"; -#endif /* LC_NUMERIC */ +#endif /* USE_LOCALE_NUMERIC */ } else { PerlIO_printf(PerlIO_stderr(), @@ -667,19 +674,19 @@ perl_init_i18nl10n(printwarn) #endif /* ! LC_ALL */ } -#ifdef LC_CTYPE +#ifdef USE_LOCALE_CTYPE perl_new_ctype(curctype); -#endif /* LC_NUMERIC */ +#endif /* USE_LOCALE_CTYPE */ -#ifdef LC_COLLATE +#ifdef USE_LOCALE_COLLATE perl_new_collate(curcoll); -#endif /* LC_NUMERIC */ +#endif /* USE_LOCALE_COLLATE */ -#ifdef LC_NUMERIC +#ifdef USE_LOCALE_NUMERIC perl_new_numeric(curnum); -#endif /* LC_NUMERIC */ +#endif /* USE_LOCALE_NUMERIC */ -#endif /* #if defined(HAS_SETLOCALE) */ +#endif /* USE_LOCALE */ return ok; } @@ -692,7 +699,7 @@ perl_init_i18nl14n(printwarn) perl_init_i18nl10n(printwarn); } -#ifdef HAS_STRXFRM +#ifdef USE_LOCALE_COLLATE /* * mem_collxfrm() is a bit like strxfrm() but with two important @@ -752,7 +759,7 @@ mem_collxfrm(s, len, xlen) return NULL; } -#endif /* HAS_STRXFRM */ +#endif /* USE_LOCALE_COLLATE */ void fbm_compile(sv) @@ -824,12 +831,12 @@ SV *littlestr; return Nullch; little = (unsigned char*)SvPVX(littlestr); s = bigend - littlelen; - if (*s == *little && memcmp((char*)s,(char*)little,littlelen)==0) + if (*s == *little && memEQ((char*)s,(char*)little,littlelen)) return (char*)s; /* how sweet it is */ else if (bigend[-1] == '\n' && little[littlelen-1] != '\n' && s > big) { s--; - if (*s == *little && memcmp((char*)s,(char*)little,littlelen)==0) + if (*s == *little && memEQ((char*)s,(char*)little,littlelen)) return (char*)s; } return Nullch; @@ -991,159 +998,6 @@ register I32 len; return newaddr; } -#if !defined(I_STDARG) && !defined(I_VARARGS) - -/* - * Fallback on the old hackers way of doing varargs - */ - -/*VARARGS1*/ -char * -mess(pat,a1,a2,a3,a4) -char *pat; -long a1, a2, a3, a4; -{ - char *s; - char *s_start; - I32 usermess = strEQ(pat,"%s"); - SV *tmpstr; - - s = s_start = buf; - if (usermess) { - tmpstr = sv_newmortal(); - sv_setpv(tmpstr, (char*)a1); - *s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1]; - } - else { - (void)sprintf(s,pat,a1,a2,a3,a4); - s += strlen(s); - } - - if (s[-1] != '\n') { - if (dirty) - strcpy(s, " during global destruction.\n"); - else { - if (curcop->cop_line) { - (void)sprintf(s," at %s line %ld", - SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line); - s += strlen(s); - } - if (GvIO(last_in_gv) && - IoLINES(GvIOp(last_in_gv)) ) { - (void)sprintf(s,", <%s> %s %ld", - last_in_gv == argvgv ? "" : GvENAME(last_in_gv), - strEQ(rs,"\n") ? "line" : "chunk", - (long)IoLINES(GvIOp(last_in_gv))); - s += strlen(s); - } - (void)strcpy(s,".\n"); - s += 2; - } - if (usermess) - sv_catpv(tmpstr,buf+1); - } - - if (s - s_start >= sizeof(buf)) { /* Ooops! */ - if (usermess) - PerlIO_puts(PerlIO_stderr(), SvPVX(tmpstr)); - else - PerlIO_puts(PerlIO_stderr(), buf); - PerlIO_puts(PerlIO_stderr(),"panic: message overflow - memory corrupted!\n"); - my_exit(1); - } - if (usermess) - return SvPVX(tmpstr); - else - return buf; -} - -/*VARARGS1*/ -void croak(pat,a1,a2,a3,a4) -char *pat; -long a1, a2, a3, a4; -{ - char *tmps; - char *message; - HV *stash; - GV *gv; - CV *cv; - - message = mess(pat,a1,a2,a3,a4); - if (diehook) { - SV *olddiehook = diehook; - diehook = Nullsv; /* sv_2cv might call croak() */ - cv = sv_2cv(olddiehook, &stash, &gv, 0); - diehook = olddiehook; - if (cv && !CvDEPTH(cv)) { - dSP; - - PUSHMARK(sp); - EXTEND(sp, 1); - PUSHs(sv_2mortal(newSVpv(message,0))); - PUTBACK; - perl_call_sv((SV*)cv, G_DISCARD); - } - } - if (in_eval) { - restartop = die_where(message); - Siglongjmp(top_env, 3); - } - PerlIO_puts(PerlIO_stderr(),message); - (void)PerlIO_flush(PerlIO_stderr()); - if (e_tmpname) { - if (e_fp) { - PerlIO_close(e_fp); - e_fp = Nullfp; - } - (void)UNLINK(e_tmpname); - Safefree(e_tmpname); - e_tmpname = Nullch; - } - statusvalue = SHIFTSTATUS(statusvalue); -#ifdef VMS - my_exit((U32)vaxc$errno?vaxc$errno:errno?errno:statusvalue?statusvalue:SS$_ABORT); -#else - my_exit((U32)((errno&255)?errno:((statusvalue&255)?statusvalue:255))); -#endif -} - -/*VARARGS1*/ -void warn(pat,a1,a2,a3,a4) -char *pat; -long a1, a2, a3, a4; -{ - char *message; - SV *sv; - HV *stash; - GV *gv; - CV *cv; - - message = mess(pat,a1,a2,a3,a4); - if (warnhook) { - SV *oldwarnhook = warnhook; - warnhook = Nullsv; /* sv_2cv might end up calling warn() */ - cv = sv_2cv(oldwarnhook, &stash, &gv, 0); - warnhook = oldwarnhook; - if (cv && !CvDEPTH(cv)) { - dSP; - - PUSHMARK(sp); - EXTEND(sp, 1); - PUSHs(sv_2mortal(newSVpv(message,0))); - PUTBACK; - perl_call_sv((SV*)cv, G_DISCARD); - return; - } - } - PerlIO_puts(PerlIO_stderr(),message); -#ifdef LEAKTEST - DEBUG_L(xstat()); -#endif - (void)PerlIO_flush(PerlIO_stderr()); -} - -#else /* !defined(I_STDARG) && !defined(I_VARARGS) */ - #ifdef I_STDARG char * mess(char *pat, va_list *args) @@ -1220,6 +1074,61 @@ mess(pat, args) } #ifdef I_STDARG +OP * +die(char* pat, ...) +#else +/*VARARGS0*/ +OP * +die(pat, va_alist) + char *pat; + va_dcl +#endif +{ + va_list args; + char *message; + int oldrunlevel = runlevel; + int was_in_eval = in_eval; + HV *stash; + GV *gv; + CV *cv; + + /* We have to switch back to mainstack or die_where may try to pop + * the eval block from the wrong stack if die is being called from a + * signal handler. - dkindred@cs.cmu.edu */ + if (curstack != mainstack) { + dSP; + SWITCHSTACK(curstack, mainstack); + } + +#ifdef I_STDARG + va_start(args, pat); +#else + va_start(args); +#endif + message = mess(pat, &args); + va_end(args); + + if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) { + dSP; + SV *msg = sv_2mortal(newSVpv(message, 0)); + + PUSHMARK(sp); + EXTEND(sp, 1); + PUSHs(msg); + PUTBACK; + perl_call_sv((SV*)cv, G_DISCARD); + + /* It's okay for the __DIE__ hook to modify the message. */ + message = SvPV(msg, na); + } + + restartop = die_where(message); + if ((!restartop && was_in_eval) || oldrunlevel > 1) + Siglongjmp(top_env, 3); + return restartop; +} + +#ifdef I_STDARG void croak(char* pat, ...) #else @@ -1250,12 +1159,16 @@ croak(pat, va_alist) diehook = olddiehook; if (cv && !CvDEPTH(cv)) { dSP; + SV *msg = sv_2mortal(newSVpv(message, 0)); PUSHMARK(sp); EXTEND(sp, 1); - PUSHs(sv_2mortal(newSVpv(message,0))); + PUSHs(msg); PUTBACK; perl_call_sv((SV*)cv, G_DISCARD); + + /* It's okay for the __DIE__ hook to modify the message. */ + message = SvPV(msg, na); } } if (in_eval) { @@ -1327,7 +1240,6 @@ warn(pat,va_alist) #endif (void)PerlIO_flush(PerlIO_stderr()); } -#endif /* !defined(I_STDARG) && !defined(I_VARARGS) */ #ifndef VMS /* VMS' my_setenv() is in VMS.c */ void @@ -1439,22 +1351,24 @@ register I32 len; } #endif -#ifndef HAS_MEMCMP +#if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) I32 my_memcmp(s1,s2,len) -register unsigned char *s1; -register unsigned char *s2; +char *s1; +char *s2; register I32 len; { + register U8 *a = (U8 *)s1; + register U8 *b = (U8 *)s2; register I32 tmp; while (len--) { - if (tmp = *s1++ - *s2++) + if (tmp = *a++ - *b++) return tmp; } return 0; } -#endif /* HAS_MEMCMP */ +#endif /* !HAS_MEMCMP || !HAS_SANE_MEMCMP */ #if defined(I_STDARG) || defined(I_VARARGS) #ifndef HAS_VPRINTF @@ -1799,9 +1713,9 @@ Sighandler_t handler; act.sa_flags |= SA_RESTART; /* SVR4, 4.3+BSD */ #endif if (sigaction(signo, &act, &oact) == -1) - return(SIG_ERR); + return SIG_ERR; else - return(oact.sa_handler); + return oact.sa_handler; } Sighandler_t @@ -1886,7 +1800,7 @@ Sigsave_t *save; } int -rsignalrestore(signo, save) +rsignal_restore(signo, save) int signo; Sigsave_t *save; { diff --git a/utils/perldoc.PL b/utils/perldoc.PL index b364405..8c5e0c9 100644 --- a/utils/perldoc.PL +++ b/utils/perldoc.PL @@ -59,6 +59,9 @@ $Is_VMS = $^O eq 'VMS'; sub usage{ warn "@_\n" if @_; + # Make sure exit status is success under VMS, so shell doesn't + # display error messages left over from startup. + ($! = 0, $^E = 1) if $^O eq 'VMS'; die <. - */ -#undef I_LOCALE /**/ - /* INTSIZE: * This symbol contains the size of an int, so that the C preprocessor * can make decisions based on it. @@ -1491,11 +1512,27 @@ */ #define HAS_ISASCII /**/ +/* HAS_SETLOCALE: + * This symbol, if defined, indicates that the setlocale routine is + * available to handle locale-specific ctype implementations. + */ +/* I_LOCALE: + * This symbol, if defined, indicates to the C program that it should + * include . + */ /* HAS_LOCALECONV: * This symbol, if defined, indicates that the localeconv routine is * available for numeric and monetary formatting conventions. */ -#undef HAS_LOCALECONV /**/ +#ifdef __DECC +# define I_LOCALE /*config-skip*/ +# define HAS_SETLOCALE /*config-skip*/ +# define HAS_LOCALECONV /*config-skip*/ +#else +# undef I_LOCALE /*config-skip*/ +# undef HAS_SETLOCALE /*config-skip*/ +# undef HAS_LOCALECONV /*config-skip*/ +#endif /* HAS_MKFIFO: * This symbol, if defined, indicates that the mkfifo routine is @@ -1532,6 +1569,14 @@ */ #define HAS_SAFE_MEMCPY /**/ +/* HAS_SANE_MEMCMP: + * This symbol, if defined, indicates that the memcmp() routine is + * available to compare memory blocks for relative magnitude. If this + * symbol is not defined, and if HAS_MEMCMP is defined, then memcmp() + * may be used only to compare memory blocks for equality. + */ +#define HAS_SANE_MEMCMP /**/ + /* HAS_SETPGRP: * This symbol, if defined, indicates that the setpgrp routine is * available to set the current process group. diff --git a/vms/descrip.mms b/vms/descrip.mms index 35e59ee..607e2d6 100644 --- a/vms/descrip.mms +++ b/vms/descrip.mms @@ -65,7 +65,7 @@ OBJVAL = $(MMS$TARGET_NAME)$(O) .endif # Updated by fndvers.com -- do not edit by hand -PERL_VERSION = 5_00308# +PERL_VERSION = 5_00310# ARCHDIR = [.lib.$(ARCH).$(PERL_VERSION)] diff --git a/vms/gen_shrfls.pl b/vms/gen_shrfls.pl index c9f51ab..87b493f 100644 --- a/vms/gen_shrfls.pl +++ b/vms/gen_shrfls.pl @@ -34,7 +34,7 @@ # (i.e. /Define=DEBUGGING,EMBED,MULTIPLICITY)? # # Author: Charles Bailey bailey@genetics.upenn.edu -# Revised: 20-Feb-1996 +# Revised: 3-Dec-1996 require 5.000; @@ -355,7 +355,7 @@ if ($ENV{PERLSHR_USE_GSMATCH}) { print OPTBLD "CLUSTER=\$\$TRANSFER_VECTOR,,,$_.$objsuffix\n"; } } -else { $incstr .= ',' . join(',',@symfiles); } +elsif (@symfiles) { $incstr .= ',' . join(',',@symfiles); } # Include object modules and RTLs in options file # Linker wants /Include and /Library on different lines print OPTBLD "$libperl/Include=($incstr)\n"; diff --git a/vms/genconfig.pl b/vms/genconfig.pl index 924fa08..521be99 100644 --- a/vms/genconfig.pl +++ b/vms/genconfig.pl @@ -6,7 +6,7 @@ # that went into your perl binary. In addition, values which change from run # to run may be supplied on the command line as key=val pairs. # -# Rev. 2-Oct-1996 Charles Bailey bailey@genetics.upenn.edu +# Rev. 3-Dec-1996 Charles Bailey bailey@genetics.upenn.edu # #==== Locations of installed Perl components @@ -154,17 +154,12 @@ foreach (@ARGV) { print OUT "i_niin=",$dosock ? "'define'\n" : "'undef'\n"; print OUT "i_neterrno=",$dosock ? "'define'\n" : "'undef'\n"; - if ($cctype eq 'decc') { - print OUT "d_stdstdio='define'\n"; - print OUT "d_stdio_ptr_lval='define'\n"; - print OUT "d_stdio_cnt_lval='define'\n"; - print OUT "d_stdiobase='define'\n"; - } - else { - print OUT "d_stdstdio='undef'\n"; - print OUT "d_stdio_ptr_lval='undef'\n"; - print OUT "d_stdio_cnt_lval='undef'\n"; - print OUT "d_stdiobase='undef'\n"; + if ($cctype eq 'decc') { $rtlhas = 'define'; } + else { $rtlhas = 'undef'; } + foreach (qw[ d_stdstdio d_stdio_ptr_lval d_stdio_cnt_lval d_stdiobase + d_locconv d_setlocale i_locale d_mbstowcs d_mbtowc + d_wcstombs d_wctomb d_mblen d_mktime d_strcoll d_strxfrm ]) { + print OUT "$_='$rtlhas'\n"; } next; } diff --git a/vms/vmsish.h b/vms/vmsish.h index a7f4e89..1e8d684 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -15,12 +15,12 @@ #include /* explicitly set in the perl source code */ /* Suppress compiler warnings from DECC for VMS-specific extensions: - * GLOBALEXT, NOSHAREEXT: global[dr]ef declarations + * GLOBALEXT, NOSHAREEXT, READONLYEXT: global[dr]ef declarations * ADDRCONSTEXT,NEEDCONSTEXT: initialization of data with non-constant values * (e.g. pointer fields of descriptors) */ #ifdef __DECC -# pragma message disable (GLOBALEXT,NOSHAREEXT,ADDRCONSTEXT,NEEDCONSTEXT) +# pragma message disable (GLOBALEXT,NOSHAREEXT,READONLYEXT,ADDRCONSTEXT,NEEDCONSTEXT) #endif /* DEC's C compilers and gcc use incompatible definitions of _to(upp|low)er() */ -- 2.7.4