Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Intrepid's scratchpad

by Intrepid (Deacon)
on Jun 03, 2004 at 13:48 UTC ( #360135=scratchpad: print w/ replies, xml ) Need Help??

2012-11-16T22:43:53 UTC-05:00

StrawberryPerl (Win32): how dmake initializes itself:

Opens C:\Strawberry\C\bin\startup\startup.mk
           C:\Strawberry\C\bin\startup\config.mk
           C:\Strawberry\C\bin\startup\local.mk
           C:\Strawberry\C\bin\startup\winnt\mingw\macros.mk
           C:\Strawberry\C\bin\startup\winnt\macros.mk
           C:\Strawberry\C\bin\startup\winnt\recipes.mk
    Closes C:\Strawberry\C\bin\startup\startup.mk

/startup/winnt/macros.mk is where most of the problems with recipes made using the SHELL, are likely to be lurking. More to come on that, as I figure out dmake's unique syntax.

Lines 32-71 of that file:
# Now set the remaining arguments depending on which SHELL we # are going to use. COMSPEC (assumed to be command.com) or # MKS Korn shell. .IF $(SHELL) == $(COMSPEC) .IF $(COMSPEC:lf) == cmd.exe SHELLFLAGS *:= $(SWITCHAR)S $(SWITCHAR)c SHELLCMDQUOTE *:= " # " fix syntax highlighting .ELIF $(COMSPEC:lf) == command.com SHELLFLAGS *:= $(SWITCHAR)c SHELLCMDQUOTE *:= " # " fix syntax highlighting .ELSE SHELLFLAGS *:= $(SWITCHAR)c .END GROUPFLAGS *:= $(SWITCHAR)c SHELLMETAS *:= "<>| # " fix syntax highlighting GROUPSUFFIX *:= .cmd DIVFILE *= $(TMPFILE:s,/,\,) RM *= del RMFLAGS *= MV *= rename __.DIVSEP-sh-yes *:= \\ __.DIVSEP-sh-no *:= \\ .ELSE SHELL !:= $(SHELL:s,/,\,) COMMAND *= $(CMNDNAME:s,/,\,) $(CMNDARGS) SHELLFLAGS *:= -c GROUPFLAGS *:= SHELLMETAS *:= *";?<>|()&][$$\#`' GROUPSUFFIX *:= .ksh .MKSARGS *:= yes RM *= $(ROOTDIR)$/bin$/rm RMFLAGS *= -f MV *= $(ROOTDIR)$/bin$/mv DIVFILE *= $(TMPFILE:s,/,${__.DIVSEP-sh-${USESHELL}},) __.DIVSEP-sh-yes *:= \\\ __.DIVSEP-sh-no *:= \\ .ENDIF

NOTES on dmake syntax:

:= expands the rhs prior to assigning it as the value of MACRO. Future expansions of MACRO do not recursively expand its value.

*:= behaves exactly as the := form with the exception that if MACRO (the lhs) already has a value then the assignment and expansion are not performed.

The ENV macros (variables) important to dmake and perl includes these:

  • SHELL: /bin/bash
  • PERL5SHELL:
  • PERL5OPT:
  • COMSPEC: C:/windows/system32/cmd.exe
  • MAKE:
  • MAKESTARTUP: C:/Users/somian/AppData/Cygwin/SRC.WRKG/dmake-localrc/startup.mk

Check them in the sh shell like so:

YIKES='SHELL,PERL5SHELL,PERL5OPT,COMSPEC,MAKE,MAKESTARTUP' perl -MEnv= +$YIKES -le \ '$iu=$ENV{YIKES}; for (split q[,],$iu) { printf qq[macros %s: %s\n], $ +_, $$_ }'


2012-11-08T05:58:23 UTC-05:00

Failure on Strawberry Perl: Devel::Symdump

Rough screen-dump provided here.

Script started on Thu, 08 Nov, 2012 5:46:16 AM ---------------------------------------------------------------------- +-------------------------------- DISTNAME => q[Devel-Symdump] LICENSE => q[perl] NAME => q[Devel::Symdump] PREREQ_PM => { Test::More=>q[0], Compress::Zlib=>q[0] } SIGN => q[1] VERSION_FROM => q[lib/Devel/Symdump.pm] clean => { FILES=>q[*/*/*~] } dist => { DIST_DEFAULT=>q[Makefile setversion README all chlog tardi +st], COMPRESS=>q[gzip -9f] } Using PERL=C:\Strawberry\perl\bin\perl.exe Writing Makefile for Devel::Symdump ---------------------------------------------------------------------- +-------------------------------- ...\Devel-Symdump-2.08_53 >dmake all && dmake test TEST_VERBOSE=6 ---------------------------------------------------------------------- +-------------------------------- cp lib/Devel/Symdump.pm blib\lib\Devel\Symdump.pm cp lib/Devel/Symdump/Export.pm blib\lib\Devel\Symdump\Export.pm C:\Strawberry\perl\bin\perl.exe "-MExtUtils::Command::MM" "-e" "test_h +arness(6, 'blib\lib', 'blib\arch')" t/*.t t/autogen.t ................. 1..8 ok 1 ok 2 ok 3 ok 4 ok 5 ok 6 ok 7 ok 8 ok t/diff.t .................... 1..1 ok 1 ok t/export.t .................. 1..2 ok 1 ok 2 ok t/glob_to_local_typeglob.t .. # OS == MSWin32 ok 1 - use Compress::Zlib; # $Devel::Symdump::VERSION == 2.08_53 ok 2 - use Devel::Symdump;# $Compress::Zlib::VERSION == 2.03 # Perl == 5.012001 ok 3 - reference assignment# ref($glob_ref) == "SCALAR" '-' is not recognized as an internal or external command, operable program or batch file. # exit value = 1 ok 4 - waitpid() # exit with signal = 0 # dumped core? 0 ok 5 - child did not SEGV # Failed test 'child exited properly' not ok 6 - child exited properly# at t/glob_to_local_typeglob.t line + 53. '-' is not recognized as an internal or external command, operable program or batch file. # exit value = 1 ok 7 - waitpid()# exit with signal = 0 # dumped core? 0 ok 8 - child did not SEGV not ok 9 - child exited properly# Failed test 'child exited properly +' # at t/glob_to_local_typeglob.t line 53. # Looks like you failed 2 tests of 9. 1..9 Dubious, test returned 2 (wstat 512, 0x200) Failed 2/9 subtests t/pod.t ..................... 1..0 # SKIP Test::Pod 1.00 required for testing POD skipped: Test::Pod 1.00 required for testing POD t/podcover.t ................ 1..1 ok 1 - Pod coverage on Devel::Symdump ok t/recur.t ................... 1..3 ok 1 ok 2 ok 3 - use Devel::Symdump; ok t/symdump.t ................. 1..13 ok 1 - main::DATA main::Hmmmm main::STDERR main::STDIN main::STDOUT ma +in::stderr main::stdin main::stdout not ok 2 - ^H ! @ ENV INC SIG# Failed test '^H ! @ ENV INC SIG' # at t/symdump.t line 51. ok 3 ok 4 ok 5 ok 6 ok 7 ok 8 ok 9 ok 10 ok 11 ok 12 # Looks like you failed 1 test of 13. ok 13 Dubious, test returned 1 (wstat 256, 0x100) Failed 1/13 subtests t/tree.t .................... 1..2 ok 1 ok 2 ok Test Summary Report ------------------- t/glob_to_local_typeglob.t (Wstat: 512 Tests: 9 Failed: 2) Failed tests: 6, 9 Non-zero exit status: 2 t/symdump.t (Wstat: 256 Tests: 13 Failed: 1) Failed test: 2 Non-zero exit status: 1 Files=9, Tests=39, 19 wallclock secs ( 0.48 usr + 0.36 sys = 0.84 CP +U) Result: FAIL Failed 2/9 test programs. 3/39 subtests failed. dmake: Error code 255, while making 'test_dynamic'

2012-08-24T04:41:42 UTC-04:00

Converting $] to a tuple “by hand” (misuse of unpack()?)

#!/bin/bash declare -x PLV_STRING function perl_v_in_use { # contrast with use of version pragma as in: # $ perl -le 'use version 0.77; print version->parse($])->normal' /usr/bin/env perl \ -e 'my $pow = 2; @qiu = split(q/[.]/=>$]);' \ -e '@qiu[1 .. @qiu] = map{sprintf(q[%u],$_/10**$pow++)} ' \ -e 'map {unpack "A4 A4",$_ * 10**3 } @qiu[1 .. $#qiu];' \ -e 'print join q[.], grep{length($_)} @qiu;' } function pviu_insurance { by_longhand="$(perl_v_in_use)" if [[ "v$by_longhand" == $(/usr/bin/env perl -e 'print $^V') ]] then return 0 else return 1 fi } function set_perl_v_in_use { if pviu_insurance then PLV_STRING=$(perl_v_in_use) else printf >&2 "WARNING: NON-SUCCESS rv \"%u\" from pviu_insu +rance\n" $? PLV_STRING='0_INVALID' fi }

Getting "prototype mismatch" warnings from Strawberryperl

Exact wording of squawkish bangling:

Prototype mismatch: sub main::stat (;$) vs ($) at C:/Strawberry/perl/lib/Exporter.pm line 64.
and ...
Prototype mismatch: sub main::lstat (;$) vs ($) at C:/Strawberry/perl/lib/Exporter.pm line 64.

use File::stat; my @alog = map { $_->[1] } sort { $b->[0] <=> $a->[0] } map { [ stat($_)->mtime , $_ ] } grep {-s && -r} bsd_glob(Global_tf . $fileglobbing_patt, GLOB_TILDE|GLOB +_ERR);
# Better write that as
use File::stat (); [ ... ] map { $_->[1] } sort { $b->[0] <=> $a->[0] } map { [ File::stat::stat($_)->mtime , $_ ] } grep {-s && -r} bsd_glob(Global_tf . $fileglobbing_patt, GLOB_TILDE|GLOB +_ERR);

That cleans up the warning, which is a warning from the automatic import of stat (and lstat) when the unqualified use File::stat; is done. Strange, though, that only one port of Perl issues the warning, while another does not. Code-diving would be instructive.


Proc::ProcessTable fields (on Cygwin)

Looking at the entry names for the fields in the table.

use strict; use Proc::ProcessTable; my $t = new Proc::ProcessTable; my @flname = $t->fields; for (my $num=1; $num < @flname; ++$num) { printf qq[%u : %s\n], $num, $flname[$num]; }

Output seen:

1 : uid 2 : pid 3 : ppid 4 : pgid 5 : winpid 6 : fname 7 : start 8 : ttynum 9 : state

Note that some sample code shown in the POD for Proc::ProcessTable uses two field names that do not exist for Cygwin (we are not calling this a code bug or even a documentation bug; merely reminding ourselves that we have to check Proc::ProcessTable->new->fields() on any OS, not assume some fields exist …except for the most obvious, such as [probably]: uid or pid).

Sample code from POD

use Proc::ProcessTable; $FORMAT = "%-6s %-10s %-8s %-24s %s\n"; $t = new Proc::ProcessTable; printf($FORMAT, "PID", "TTY", "STAT", "START", "COMMAND"); foreach $p ( @{$t->table} ){ printf($FORMAT, $p->pid, $p->ttydev, # NOPE! $p->state, scalar(localtime($p->start)), $p->cmndline # NOPE! ); }

Embedded perl does strange wrongness for __FILE__ builtin.

Fix:

sub weirdnessFILE { my $FILE_name_from_perl = __FILE__; $FILE_name_from_perl = substr( $FILE_name_from_perl , rindex($FILE_name_from_perl,q[ +]) + 1) }


YAML Dump() vs Data::Dumper Dump()

I would like to learn to use YAML's routine to get a dump like that given by Data::Dumper's Dump() eh. Output that demonstrates the difference I am seeing is below.

# YAML 1.1: --- - BaseDirectorySpec - XDG_CACHE_HOME: $HOME/.cache XDG_CONFIG_DIRS: '' XDG_CONFIG_HOME: $HOME/.config XDG_DATA_DIRS: '' XDG_DATA_HOME: $HOME/.local/share # Data-Dumper: $BaseDirectorySpec = { 'XDG_CACHE_HOME' => '$HOME/.cache', 'XDG_CONFIG_HOME' => '$HOME/.config', 'XDG_DATA_HOME' => '$HOME/.local/share', 'XDG_DATA_DIRS' => '', 'XDG_CONFIG_DIRS' => '' };

The brief "show-the-code" disclosure of my code that is producing the output above looks like this (without even trying to show the code that supplies the data; it has to suffice to say that $listing is a reference to a hash.

print STDERR Dump([q[BaseDirectorySpec]=> $listing]); print STDERR Data::Dumper->Dump([$listing],[q/BaseDirectorySpec/] +);

Building Perl (v5.12.3) from vanilla Source Code Kit

The odd construct encountered and discussed on the chatterbox on 03 Feb 2011

The contruct:

$(LDLIBPTH) $(RUN) ./miniperl$(HOST_EXE_EXT) -w -Ilib -MExporter - +e '<?>' || $(MAKE) minitest

The focus of this Makefile recipe line is the perl 1-liner

-e '<?>'

Another Monk and I both think that perhaps this expression is being used for the obscure side-effect of testing whether trying to use perl's glob routine will trigger a die.

I replaced it with this code:

$(LDLIBPTH) $(RUN) ./miniperl$(HOST_EXE_EXT) -w -Ilib -MExporter\ -e '$$al=eval q|<?akefil?>|; if ((not $$@) and $$al){ \ -e q|t| and printf qq[%s\n], qq[Ok to `make minitest`]; exit 0 } exit + 1' || $(MAKE) minitest

That winds up being executed as this commandline:

LD_LIBRARY_PATH=/home/amphibole/SRC.BUILD/RECHK/perl-5.12.3 /home/amph +ibole/SRC.BUILD/RECHK/perl-5.12.3/preload /home/amphibole/SRC.BUILD/R +ECHK/perl-5.12.3/libperl5_12.so ./miniperl -w -Ilib -MExporter\ -e '$al=eval q|<?akefil?>|; if ((not $@) and $al){ \ -e q|t| and printf qq[%s\n], qq[Ok to `make minitest`]; exit 0 } exit + 1' || make minitest

I don't swear to conviction that everything is right in that code, but it is not more wrong than what the unaltered P-S-K tree will do for the user, I think.


For perlmonk.org admin; troubleshooting module path issues that are complaints emitted when running cpanplus

/bin/pwd: couldn't find directory entry in `..' with matching i-node Can't locate DBIx/Simple.pm in @INC (@INC contains: /home/intrepid/lib/perl/i686-linux /home/intrepid/li +b/perl /etc/perl /usr/lib/perl5/site_perl/5.12.2/i686-linux /usr/lib/ +perl5/site_perl/5.12.2 /usr/lib/perl5/vendor_perl/5.12.2/i686-linux / +usr/lib/perl5/vendor_perl/5.12.2 /usr/lib/perl5/5.12.2/i686-linux /us +r/lib/perl5/5.12.2 /usr/lib/perl5/site_perl /usr/lib/perl5/vendor_per +l /usr/local/lib/site_perl .) at /usr/lib/perl5/5.12.2/CPANPLUS/Internals/Source/SQLite.pm line 1 +3. BEGIN failed--compilation aborted at /usr/lib/perl5/5.12.2/CPANPLUS/In +ternals/Source/SQLite.pm line 13. Compilation failed in require at /usr/lib/perl5/5.12.2/Module/Load.pm +line 27. [THIS MAY BE A PROBLEM!] at /usr/lib/perl5/5.12.2/CPANPLUS/Internals. +pm line 204 [ERROR] Could not load source engine 'CPANPLUS::Internals::Source::SQL +ite'

Modified and improved CPAN+ (cpanplus) host-checking routine

# script by somian (Sören Andersen) use strict; use warnings; # First created: 2010-11-04 04:44:09+00:00 # Last MODIFIED: Thursday 11/04/2010 04:57 UTC my @M; use URI; use CPANPLUS::Backend; my $c = CPANPLUS::Backend->new()->configure_object; my $WII = $c->conf->conf->{hosts}; foreach my $hr (@$WII) { foreach my $eq(@$hr) { my %l=%{$eq}; my @lr; my $mhost = URI->new; printf STDERR "%-9s %s\n" , $lr[0] , $lr[1] while @lr = each %l; $mhost->scheme($l{scheme}); $mhost->authority($l{host}); $mhost->path($l{path}); push @M, $mhost; } } printf "%s\n", $_->as_string for @M;

See the URI / hostlist in cpanplus' Configured Universe

perl -MYAML=Dump -MCPANPLUS::Backend -le \ '$c=CPANPLUS::Backend->new()->configure_object;' -e 'for($c->conf) { print Dump(@$_) for $_->conf->{hosts} }'

Output:

--- - host: ftp.cpan.org path: /pub/CPAN/ scheme: ftp - host: www.cpan.org path: / scheme: http - host: ftp.nl.uu.net path: /pub/CPAN/ scheme: ftp - host: cpan.valueclick.com path: /pub/CPAN/ scheme: ftp - host: ftp.funet.fi path: /pub/languages/perl/CPAN/ scheme: ftp


Error installing using cpanplus and my hack for Ubuntu

ERROR MAKE INSTALL failed:

Bad file descriptor open3: exec of /usr/bin/sudo PERL5LIB="/opt/cpan-installed/perl/lib/perl5:/opt/cpa +n-installed/perl/module-lib/5.10/arch/i486-linux-gnu-thread-multi:/op +t/cpan-installed/perl/module-lib/5.10/lib" /usr/bin/make install failed at /opt/cpan-installed/perl/lib/perl5/IPC/Cmd.pm line 505


YAML serialization | Ubuntu mirrors in some selected countries

--- United States: - http://mirror.anl.gov/pub/ubuntu/ - http://mirror.pnl.gov/ubuntu/ - http://mirrors.us.kernel.org/ubuntu/ - http://76.73.4.58/ubuntu/ - http://astromirror.uchicago.edu/ubuntu/ - http://ftp.egr.msu.edu/pub/ubuntu/archive/ - http://ftp.usf.edu/pub/ubuntu/ - http://mirror.umoss.org/ubuntu/ - http://mirror.uoregon.edu/ubuntu/ - http://mirrors.cat.pdx.edu/ubuntu/ - http://mirrors.ccs.neu.edu/ubuntu/ - http://mirrors.easynews.com/linux/ubuntu/ - http://mirrors.ecvps.com/ubuntu/ - http://mirrors.login.com/ubuntu/ - http://mirrors.rit.edu/ubuntu/ - http://mirrors.xmission.com/ubuntu/ - http://ubuntu.mirrors.tds.net/pub/ubuntu/ - http://ubuntu.media.mit.edu/ubuntu/ - http://ubuntu.mirrors.pair.com/archive/ - http://ubuntu.secsup.org/ - http://ubuntu.wallawalla.edu/ubuntu/ - http://ubuntu.wikimedia.org/ubuntu/ - http://mirror.cs.umn.edu/ubuntu/ - http://www.club.cc.cmu.edu/pub/ubuntu/ - http://www.gtlib.gatech.edu/pub/ubuntu/ - http://archive.linux.duke.edu/ubuntu/ - http://lug.mtu.edu/ubuntu/ - http://mira.sunsite.utk.edu/ubuntu/ - http://mirror.alfredstate.edu/ubuntu/ - http://mirror.cc.columbia.edu/pub/linux/ubuntu/archive/ - http://mirror.clarkson.edu/ubuntu/ - http://mirror.hmc.edu/ubuntu/ubuntu/ - http://mirror.hosef.org/ubuntu/ - http://mirror.its.uidaho.edu/pub/ubuntu/ - http://mirrors.acm.jhu.edu/ubuntu/ - http://mirrors.pavlovmedia.net/ubuntu/ - http://samaritan.ucmerced.edu/ubuntu/ - http://ubuntu.eecs.wsu.edu/ - http://ubuntu.mirror.frontiernet.net/ubuntu/ - http://ubuntu.osuosl.org/ubuntu/ - http://ubuntu.securedservers.com/ - http://www.lug.bu.edu/mirror/ubuntu/ - http://mirror.math.ucdavis.edu/ubuntu/ - http://mirrors.bloomu.edu/ubuntu/ - http://ftp.ussg.iu.edu/linux/ubuntu/ - http://ftp.utexas.edu/ubuntu/ - http://mirror.calvin.edu/ubuntu/ - http://mirror.vcu.edu/pub/gnu+linux/ubuntu/ - http://mirrors.cs.wmich.edu/ubuntu/ - http://ubuntu.cs.utah.edu/ubuntu/ - http://ubuntu.secs.oakland.edu/ --- United Kingdom: - http://www.mirrorservice.org/sites/archive.ubuntu.com/ubuntu/ - http://ftp.ticklers.org/archive.ubuntu.org/ubuntu/ - http://mirror.as29550.net/archive.ubuntu.com/ - http://mirror.bytemark.co.uk/ubuntu/ - http://mirror.ox.ac.uk/sites/archive.ubuntu.com/ubuntu/ - http://mirror.sov.uk.goscomb.net/ubuntu/ - http://mirror01.th.ifl.net/ubuntu/ - http://ubuntu.datahop.net/ubuntu/ - http://archive.ubuntu.com/ubuntu/ - http://mirrors.melbourne.co.uk/ubuntu/ - http://ubuntu.positive-internet.com/ubuntu/ - http://ubuntu.retrosnub.co.uk/ubuntu/ - http://ubuntu.virginmedia.com/archive/ --- Ireland: - http://ftp.heanet.ie/pub/ubuntu/ - http://ftp.esat.net/mirrors/archive.ubuntu.com/ --- Finland: - http://mirrors.nic.funet.fi/ubuntu/ - http://www.nic.funet.fi/pub/mirrors/archive.ubuntu.com/ - http://ubuntu.trumpetti.atm.tut.fi/ubuntu/ --- Austria: - http://ubuntu.inode.at/ubuntu/ - http://ubuntu.lagis.at/ubuntu/ - http://ubuntu.uni-klu.ac.at/ubuntu/ - http://gd.tuwien.ac.at/opsys/linux/ubuntu/archive/

Adding a needed method to the HTML::Element namespace

package HTML::Element; sub that_is_empty { my $ct; return undef unless 1 == @{ ($ct = (shift)->attr('_content')) }; my $lkr; my $dlv = $ct->[0]; while (ref $dlv eq 'HTML::Element') { $lkr = $dlv; ($dlv) = @{$dlv->content_array_ref}; } $lkr=~/\A[[:blank:][:cntrl:]\x{a0}]*\Z/; }

Reason: the output of that wretched Microsoft FrontPage program sometimes includes empty paragraphs that contain only the ASCII character \x{a0} and have no productive role in the presentational or semantic aspect of the document. This method detects such a node (and could thus be used to eliminate it from the HTML::Tree).


Seeing error mentioned with (ExtUtils::MakeMaker) ExtUtils::Install (.pm)

This space was formerly occupied by an inquiry which has now come to be regarded as "solved" (by Intrepid) and which is posted in Meditations at "Distro Pkg-Managed, broken Install.pm, sudo clears $PERL5LIB". ;-)


Injury to performance But perhaps interesting to contemplate:

jdporter created node Parse a list of path strings into a nested hash today and I spent a little time thinking about the code. I offer the following variation on his subroutine paths2tree.

sub somian_paths2tree { my $hr = {}; @{$hr}{@_} = map { {} } @_; my $n_repls; do { $n_repls=0; for ( map { $_->[0] } sort { $b->[1] <=> $a->[1] || length($b->[0]) <=> length($a->[0]) } map { [$_, 1 + (my@n =m{[\\]+}g)] } keys + %$hr ) { if ( /(.*)\\(.*)/ ) { $hr->{$1}{$2} = delete $hr->{$_}; $n_repls++; } } } while ( $n_repls ); $hr }
Code tested on: iX86-linux in sh shell with perl 5.10
Perl one-liner

Purpose: formulate a plausible naming scheme for arch-dep subdirectories bin/, lib/ and so forth

perl \ -e 'chomp (my(@sn)=(`uname -m`, `uname -s`));' \ -e 'my $glibcso = q%/lib/libc.so.%;' \ -e '$glibcso=(-e "${glibcso}6" ? "${glibcso}6":-e "${glibcso}5" ? "$ +{glibcso}5":"");' \ -e 'if ($glibcso) {' \ -e 'open my $scf, "-|", $glibcso or die "$glibcso : ",$!;' \ -e 'my $crv=<$scf>; close $scf;' \ -e '$crv=~m/[ ]version[ ]([^ ,]{1,4})/ && (push @sn, "gnu_libc_v$1") + }' \ -e 'printf "%s\n", join q/_/=> map{"\L$_"}@sn;'
sh functs implementing the above
function dump_arch_dep { perl \ -e 'my $Psi=$ARGV[0]; die unless $Psi && -e $Psi;' \ -e 'chomp (my(@sn)=(`uname -m`, `uname -s`));' \ -e 'open my $scf, "-|", $Psi or die;' \ -e 'my $crv=<$scf>; close $scf;' \ -e '$crv=~m/[ ]version[ ]([^ ,]{1,4})/ && (push @sn, "gnu_libc_v$1") +;' \ -e 'print join q/_/=> map{"\L$_"}@sn;' \ -e 'print "\n"' $1 } function show_osma { declare +x -a _Gv=(6 5) declare +x Discovered_GLIBC for LVA in ${_Gv[@]} do if [[ -e /lib/libc.so.$LVA && -x /lib/libc.so.$LVA ]] then Discovered_GLIBC=/lib/libc.so.$LVA break fi done if [[ -n $Discovered_GLIBC ]]; then dump_arch_dep $Discovered_GLIB +C; fi }

The string output on my system's console was "i686_linux_gnu_libc_v2.9" (without quotes).

The string output on perlmonk.org in a shell was ".i686_linux_gnu_libc_v2.11"

I put these functions in a file named ~/.bash_common so that I can call them as routines in other ad-hoc shell scripting I may do from time to time.


Get a UUID for a removable media disk under GNU/Linux

Insert disk and then do $ dmesg | tail -26

  • Determine partition number (on some disks, no partition, use the whole device)
  • Insert the partition dev designator where "sdb" appears below:
    $ find /dev/disk/by-uuid -lname '*/sdb?' -printf '%l %f\n'|sed 's:^\ +.\./\.\./:/dev/:'

    Again, note that " -lname '*/sdb?' " must be replaced by the device designator a la dmesg logging that indicates your just plugged-in disk.

On a full Gnome desktop such as is typical in mainline Ubuntu, this kind of manual procedure is unlikely to be useful. When running something a bit more lean like openbox the UUID can be useful to create /etc/fstab entries for mounting device disks, though.


snippet: sh-like shell code (say, for ~/.profile)
[[ ":$PATH:" == *:$dir:* ]] && PATH="$dir:$PATH "

MS Windows (NT-family) devices
In Windows we see 5B76039A52D8 in the raw USB storage device described + as: \Device\0000009d = USBSTOR#Disk&Ven_Kingston&Prod_DataTraveler_2.0&R +ev_PMAP#5B76039A52D8&0#{53f56307-b6bf-11d0-94f2-00a0c91efb8b} In Windows we see 5B76039A52D8 in the Disk Volume device described by: \Device\HarddiskVolume9 = STORAGE#Volume#1&19f7e59c&0&_??_USBSTOR#Disk +&Ven_Kingston&Prod_DataTraveler_2.0&Rev_PMAP#5B76039A52D8&0#{53f56307 +-b6bf-11d0-94f2-00a0c91efb8b}#{53f5630d-b6bf-11d0-94f2-00a0c91efb8b}

SVK-2.0.2 Dependency Hell
*** Module::AutoInstall version 1.030 *** Checking for Perl dependencies... [Core Features] - Test::More ...loaded. (0.620 >= 0.42) - version ...missing. (would need 0.68) - Algorithm::Annotate ...missing. - Algorithm::Diff ...loaded. (1.190100 >= 1.1901) - YAML::Syck ...loaded. (0.710 >= 0.60) - Data::Hierarchy ...missing. (would need 0.30) - PerlIO::via::dynamic ...missing. (would need 0.11) - PerlIO::via::symlink ...missing. (would need 0.02) - IO::Digest ...missing. - SVN::Simple::Edit ...missing. (would need 0.27) - URI ...loaded. (1.350) - PerlIO::eol ...missing. (would need 0.13) - Class::Autouse ...missing. (would need 1.15) - App::CLI ...missing. - List::MoreUtils ...missing. - Class::Accessor::Fast ...loaded. (0.300) - Class::Data::Inheritable ...missing. - Path::Class ...missing. (would need 0.16) - UNIVERSAL::require ...missing. - Term::ReadKey ...missing. - Time::HiRes ...loaded. (1.860) - File::Temp ...missing. (would need 0.17) - Encode ...loaded. (2.120 >= 2.10) - Getopt::Long ...loaded. (2.350 >= 2.35) - Pod::Escapes ...loaded. (1.040) - Pod::Simple ...loaded. (3.040) - File::Spec ...missing. (would need 3.19)

Cygwin Goes Nuts

Trying to open a subshell in the build directory... Fetching with LWP: ftp://ftp.funet.fi/pub/languages/perl/CPAN/authors/id/C/CO/COSIMO/Wi +n32-API-0.43.tar.gz Fetching with LWP: ftp://ftp.funet.fi/pub/languages/perl/CPAN/authors/id/C/CO/COSIMO/CH +ECKSUMS Checksum for /usr/local/src/.cpan/sources/authors/id/C/CO/COSIMO/Win32 +-API-0.43.tar.gz ok 10 [main] ? (1616) C:\cygwin\bin\perl.exe: *** fatal error - C:\c +ygwin\bin\perl.exe: *** MEM_COMMIT failed, Win32 error 1455 8 [main] ? (2680) C:\cygwin\bin\perl.exe: *** fatal error - C:\c +ygwin\bin\perl.exe: *** MEM_COMMIT failed, Win32 error 1455 13 [main] ? (248) C:\cygwin\bin\perl.exe: *** fatal error - C:\cy +gwin\bin\perl.exe: *** MEM_COMMIT failed, Win32 error 1455 8 [main] ? (644) C:\cygwin\bin\perl.exe: *** fatal error - C:\cy +gwin\bin\perl.exe: *** MEM_COMMIT failed, Win32 error 1455 8 [main] ? (3548) C:\cygwin\bin\perl.exe: *** fatal error - C:\c +ygwin\bin\perl.exe: *** MEM_COMMIT failed, Win32 error 1455 7 [main] ? (2320) C:\cygwin\bin\perl.exe: *** fatal error - C:\c +ygwin\bin\perl.exe: *** MEM_COMMIT failed, Win32 error 1455 12 [main] perl 4048 fork: child -1 - died waiting for longjmp bef +ore initialization, retry 0, exit code 0x100, errno 11 panic: MUTEX_LOCK (45) [util.c:2266] at /usr/lib/perl5/5.8/CPAN.pm lin +e 5819. panic: MUTEX_LOCK (45) [pad.c:1356] at /usr/lib/perl5/vendor_perl/5.8/ +cygwin/Term/ReadLine/Gnu.pm line 680. panic: MUTEX_LOCK (45) [pad.c:1356] at /usr/lib/perl5/vendor_perl/5.8/ +cygwin/Term/ReadLine/Gnu.pm line 680. panic: MUTEX_LOCK (45) [op.c:354] at /usr/lib/perl5/vendor_perl/5.8/cy +gwin/Term/ReadLine/Gnu.pm line 680.

Get information on a module

perltest () { perl -e' my$modn = my$mod = "'$1'"; $mod =~s@::@/@g; $mod.=q[.pm]; die ("module $modn not installed.\n",$@) if ! eval {require qq[$mod];}; my $modv = defined ${$modn.q[::VERSION]} ? ${$modn.q[::VERSION]} : q{[version undefined]}; my$numtyp= (2 > $modv =~tr/.//) ? "%s" : "% 6d"; printf " %-*s $numtyp in %s\n", length($modn) > 30 ? 5+length($modn) : 15+length($modn), $modn, $modv, $INC{$mod}; '; return 0 }

Makefile.PL for Math::GMP

use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. use File::Find; my ( $extra_external_top # ${DESTDIR}/prefix directory to which l +ibgmp lib and header were installed , $extra_external_libdir # subdir under that where the libgmp.a f +ile (or gmp.lib, etc.) is , $extra_external_incdir # subdir under that where the gmp.h head +er file needed for compilation is , $lib_basefn # the base filename of the library that +provides the linkable objects we need , %MMext # Fully-formed params for WriteMakefile ); %MMext = (); if ( -d './extlib' ) { $extra_external_top = './extlib'; find( sub{ return unless -f and m{^(libgmp\.a|gmp\.lib)$}; $lib_basefn = $1; $extra_external_libdir = $File::Find::dir; } , $extra_external_top ); find( sub{ return unless -f and $_ eq 'gmp.h'; $extra_external_incdir = $File::Find::dir; } , $extra_external_top ); if ($extra_external_incdir and $extra_external_libdir) { my $gnustyle = $lib_basefn; $gnustyle=~ s{^(?:lib)?(\S+)\.(?:a|lib)$} {$1}; %MMext = ( 'INC' => '-I'.$extra_external_incdir ,'LIBS' => '-L'.$extra_external_libdir ." "."-l".$gnustyle ); } } WriteMakefile( 'NAME' => 'Math::GMP', 'VERSION_FROM' => 'lib/Math/GMP.pm', # finds $VERSION %MMext, ); #------------------ sub MY::post_initialize { #------------------ my $mm_self = shift(); return <<" DO!INTERPOLATE!"; # MakeMaker mechanism being directed to add include dir (where cc look +s for headers): # $extra_external_incdir # MakeMaker mechanism being directed to add lib search (what ExtUtils: +:Liblist operates # on): # $extra_external_libdir # And looking there for $lib_basefn DO!INTERPOLATE! #------------------ } #**** E O S **** #------------------

Small puzzle with how to use constant and qr together.

use constant eXEO # the object created from the main src module. => quotemeta q/a-visprint\$(EXEEXT)/; use constant eXEF # the main exe target file. => quotemeta q/alpha-visprint.o/; my $r_exeo = eval { "qr{".eXEO() ."}" }; my $r_exef = eval { "qr{".eXEF() ."}" };

Mystery data

The following patterns of mystery data (type REG_BINARY) are found as values under the given key (value name on the left of the = token). What do you think M$ is storing?

[HKEY_LOCAL_MACHINE\SYSTEM\MountedDevices] "\\DosDevices\\C:" = 5d e2 5d e2 00 7e 00 00 00 00 00 00 "\\DosDevices\\E:" = 5d e2 5d e2 00 40 11 95 04 00 00 00 "\\DosDevices\\F:" = 05 e6 5e 09 00 7e 00 00 00 00 00 00 "\\DosDevices\\S:" = 5d e2 5d e2 00 7c f3 0a 04 00 00 00

Perl/Tk and the Tk::Photo class (widget)

Both of these scripts fail completely at the first image (Photo class widget of Tk) on both MSWin32 and GNU/Linux.

use strict; use Tk; use constant ROWLEN => 3; my $mw = MainWindow->new; $mw->geometry("+10+90"); my $pixframe = $mw->Frame(); # $pixframe is the elastic rubber-band that holds our pix. for ( 1 .. ROWLEN ) { my @row; my $name = "Imfz"; for my $imgwi (qw { tpattern_4.gif tpattern_5.gif tpattern_6.gif }) { my $imgobj = $pixframe->Photo(++${name}, -format=> 'gif'); $imgobj->read( $imgwi ) or die "FAILURE to READ $imgwi:\n$!"; printf 'Seeing img "'.$name.'" with width %3u and height %3u in fo +rmat %s'.$/ ,$imgobj->width(), $imgobj->height(), $imgobj->cget('-form +at'); push @row, $imgobj; } $row[0]->grid (@row[1..$#row]); } $pixframe->pack(); MainLoop; exit 0;

OR try this (IF you have the Unix ImageMagick package installed)

#!/usr/bin/env perl # Last MODIFIED: Mon Aug 11 12:34:52 UTC 2008 no locale; use Cwd ('cwd'); use File::Spec; use Tk; use Tk::widgets qw( Frame Photo ); use strict; select STDERR; $| = 1; select STDOUT; $| = 1; use constant ROWLEN => 2; use constant GRFORMAT => "gif"; $\ = "\n"; my $pwd = cwd; my $mw = MainWindow->new; $mw->geometry("+10+90"); my $pixframe = $mw->Frame(); my @XColors = qw(midnightblue turquoise gold salmon) ; my @Fractal = map { 'TileP_'. $_ .'.'. GRFORMAT } @XColors; print STDERR qq|Using files |, join q| |, @Fractal; unless ( scalar(@XColors) == grep { -f } @Fractal ) { # Create images programmatically using the sh shell and ImageMagick # if we did not already make them system q{for COLT in }. join(q[ ]=>@XColors) .q{; do convert -size 356x356 fractal:$COLT -depth 8 -geometry 64x64 + } .q{-colors 256 }. GRFORMAT .q{:TileP_$COLT.} . GRFORMAT .q{ ; done} and die "Uh-oh, we didn't get our images made"; } my $section = 0; for ( 1 .. ROWLEN ) { my $rndx = $_; my @across; my $name = "Imfz"; my @imgstrip = map { File::Spec->catfile($pwd => $_) } @Fractal [ $section .. ($section + ROWLEN - 1) ]; # print STDERR "Image strip is @imgstrip"; my $Col_0_Pic = $pixframe->Photo( '-format' => GRFORMAT , '-file' => $imgstrip[0]); for my $imgwi ( @imgstrip ) { print STDERR "Attempting to add image \"$imgwi\" to row $rndx +now."; ++${name}; my $Photo = $pixframe->Photo(-format=> GRFORMAT, -file=> $imgw +i); printf STDERR 'Seeing img with width %3u and height %3u in format %s'."\n" , $Photo->width() , $Photo->height(), $Photo->cget('-fo +rmat'); # print STDERR for keys %$Photo; push @across, $Photo; } $Col_0_Pic->Tk::grid ( @across[1 .. $#across] ); $section += ROWLEN; } $pixframe->pack(); MainLoop; exit 0;

How I am creating ordinary paragraphs for Perlmonks node writeups these days

sh-prompt $ perl -MText::Wrap='wrap,$columns' \ -MText::Textile=textile \ -lp000we \ 'INIT{$columns=78} s{\cM?\cJ} [ ]g; $_=wrap(q[],q[ ],textile($_)).$\;' DRAFT.TMP

Rewrite of the new jigsaw-puzzle piece that is
ExtUtils::MakeMaker::Config
(from ExtUtils::MM v6.30)

UNTESTED
package ExtUtils::MakeMaker::Config; use vars ('$VERSION'); $VERSION = '0.02'; use strict; my $cm; if (eval "require Config_mingw" and not $@) { foreach my $inck (keys %INC) { if ($inck =~ s/(^Config_\w+)\.pm$/$1/) { $cm = $inck; last; } } } if (not $cm) { eval "use Config (); %ExtUtils::MakeMaker::Config::Config = %Config:: +Config;"; } else { eval "use $cm; use Config;" if $cm; } sub import { my $caller = caller; no strict 'refs'; *{$caller.'::Config'} = \%ExtUtils::MakeMaker::Config::Config; } 1; __END__

a .inputrc for 'sh'-like shells on mswin32 pc's, that use gnu readline

(whether you knew it or not)

set bell-style none # Enable 8bit input set meta-flag On set input-meta On # Turns off 8th bit stripping set convert-meta Off # Keep the 8th bit for display set output-meta On # This is actually equivalent to "\C-?": delete-char "\e[3~": delete-char "\e[1~": beginning-of-line "\e[4~": end-of-line "\e[H": beginning-of-line "\e[F": end-of-line "\e[7~": beginning-of-line "\e[8~": end-of-line
Output of cpan mirror testing

$ cpan-precheck "/usr/local/buildstuff/.cpan/sources/MIRRORED.BY" was last MODIFIED: F +ri Sep 10 07:46:50 2004 Running netselect to choose 1 out of 5 addresses. ........................ mirrors.rcn.net 45 ms 14 hops 100% ok (10/10 +) [ 108] ftp.ncsu.edu 52 ms 18 hops 90% ok ( 9/10 +) [ 162] ftp-mirror.internap.com 9999 ms 30 hops 0% ok 206.252.192.18 9999 ms 30 hops 0% ok 206.252.192.19 9999 ms 30 hops 0% ok 108 mirrors.rcn.net


Start up Gvim as the "View Source" external tool from Opera (or anyone) on WinXP {ONLY}

A few more tricks are added to the CMD.exe interpreter each time MS releases another generation of Windows. XP has some that weren't in NT (I skipped W2K). Here's a little batch file that I use to start up my favorite Text Editor.

@ECHO OFF :: Run Gvim as source viewer from Opera, with our preferences loaded a +s they :: would be when running Gvim normally. This batch script is only for +Win XP. FOR /F "usebackq" %%U IN (`C:\WINNT\System32\solidify "%USERPROFILE%"` +) DO set MyHome=%%U% CALL :StartWhr %1 rem inder main thread of execution proceeds from here to Gvim invoke. GOTO RUNGVIM :SOLHO set STIN="%~fs1"\MYDOCU~1 GOTO :EOF :StartWhr SET WHLSTR=%1 SET CRITERION=%WHLSTR:~-15,4% :: ...Opera\Opera7\profile\cache4\opr00N3Y.html" is typical. if NOT "\opr" == "%CRITERION%" SET STIN=%~dps1 if "\opr" == "%CRITERION%" CALL :SOLHO "%USERPROFILE%" GOTO :EOF :RUNGVIM START /D%STIN% C:\AdditionalPrograms\vim6\vim63\gvim.exe -U %MyHome%/A +PPLIC~1/Vim/_creamrc -c ":colorscheme Autumn | cd %STIN%" %1

Something to improve on

From MinGW's site docs

open (OUTFILE,">dll.def"); print OUTFILE "EXPORTS\n"; open (INFILE,"dll.fil"); while(<INFILE>) { if ($_ =~ /T _/) { $line = $_; $line =~ s/.* T _//; print OUTFILE $line; } } close (INFILE); close (OUTFILE); If you have a dll file named file.dll. At the command line, type: nm file.dll > dll.fil perl dll.pl

Building GD.pm against (to be run under/with) ActivePerl using MinGW

Output of make, showing attempt to build the DLL

C:/textmode_tools/MinGW/bin/gcc.exe
-o
blib/arch/auto/GD/GD.dll
-mdll
-L"C:/Perl/lib/CORE"
GD.o
C:/Perl/lib/CORE/perl58.lib
C:/cygwin/lib/w32api/libkernel32.a
C:/cygwin/lib/w32api/libuser32.a
C:/cygwin/lib/w32api/libgdi32.a
C:/cygwin/lib/w32api/libwinspool.a
C:/cygwin/lib/w32api/libcomdlg32.a
C:/cygwin/lib/w32api/libadvapi32.a
C:/cygwin/lib/w32api/libshell32.a
C:/cygwin/lib/w32api/libole32.a
C:/cygwin/lib/w32api/liboleaut32.a
C:/cygwin/lib/w32api/libnetapi32.a
C:/cygwin/lib/w32api/libuuid.a
C:/cygwin/lib/w32api/libwsock32.a
C:/cygwin/lib/w32api/libmpr.a
C:/cygwin/lib/w32api/libwinmm.a
C:/cygwin/lib/w32api/libversion.a
C:/cygwin/lib/w32api/libodbc32.a
GD.def

Suckage, deep slurpy grim suckage (?)

#! /usr/bin/perl # whatperl.pl - show that some code is b0rken. # $self, $ver, $names, $dirs, $trace my $PLACES_TO_SEARCH = [ qw' C:\Perl\bin C: C:/Perl/bin ' ]; use ExtUtils::MakeMaker; use ExtUtils::MM_Win32; my $self = ExtUtils::MakeMaker->new(); my $result = ExtUtils::MM_Win32::find_perl( $self, 5, [qw'perl.exe perl.EXE PERL.EXE'], $PLACES_TO_SEARCH , 3 ); if ($result and length $result) { print "$result\n"; } exit;

2004.Dec.17 $ h2xs -XAn Term::VTxxx::ColorTweak Writing Term/VTxxx/ColorTweak/ColorTweak.pm Writing Term/VTxxx/ColorTweak/Makefile.PL Writing Term/VTxxx/ColorTweak/README Writing Term/VTxxx/ColorTweak/test.pl Writing Term/VTxxx/ColorTweak/Changes Writing Term/VTxxx/ColorTweak/MANIFEST

... Vim? hello? What's wrong?!?

" File First created: 28 Nov 2004 17:15:08 EST " File Last MODIFIED: 28 Nov 2004 17:49:18 " Author: Soren Andersen funct! SplitReg(regname) let My_CLine = line('.') exe 'let My_Text = @' . a:regname let Init = 0 let Finger = 0 while (Finger = match(My_Text, ',', Init)) > 0 let Elem = strpart(My_Text, Init, Finger - Init) append( My_CLine++, Elem ) let Init = Finger + 1 endwh " append( My_CLine, strpart(My_Text, endfu

the HERE doc mysteries

sub hIppO { my %nonStyle = { "BACKGROUND" => "background-image" ,"BGCOLOR" => "background-color" ,"TEXT" => "color" ,"LINK" => "a:link" ,"ALINK" => "a:active" ,"VLINK" => "a:visited" }; my $adata = splitUnQ(shift); my ($ila,$hsd); for (keys %$adata) { my $canon = uc $_; if ( substr($nonStyle{ $canon },0,2) eq q[a:] ) { my $pfysti = sprintf q[%13s]=>$nonStyle{ $canon }; ($hsd .= <<" EOHDOC") =~ s#^\s+##; $pfysti { color : $adata->{ $_ } ; } EOHDOC } else { $ila .= " $nonStyle{ $canon } : $adata->{ $_ };" } } if ( $hsd ) { (my $ilp = <<' EOHDOC') =~ s#^\s+##; <style type="text/css"> <!-- EOHDOC ($hsd = $ilp . $hsd .<<' EOHDOC') =~ s#^\s+##; body { $ila } EOHDOC ($hsd .= <<' EOHDOC') =~ s#^\s+##; // --> </style> EOHDOC $ila = qq[<body>]; } else { $ila = qq[<body style="$ila">]; } return ($hsd,$ila); }

CPAN settings

Instructions for setting up cpan ...

  1. First create, if it does not already exist, a directory
    $HOME/.cpan/CPAN/
  2. Then run the following code:
    perl -MCPAN -le 'CPAN::Config->init;$fulp=$INC{q[CPAN/Config.pm]}; pri +ntf qq[%-72s %o\n],$fulp,((stat $fulp)[2]& 07777 )'
  3. Assuming that all is well - the file is found and is readable by you, which it would just about have to be ... copy it to the directory you just created but renamed MyConfig.pm instead of just "Config.pm".

end CPAN settings

Bitten

my @Str = map { my $wholho=$_; s#^( (?:ht|f)tp:// ) ( [^/]+ )/.*$ #$2#x; [ $_,$wholho ] } @{$CPAN::Config->{urllist}};

Strange troubles understanding why method of File::stat is failing

my $m_l_p = stat($mirr_list_file_path); my $m_l_f = stat($mirr_list); print STDERR qq/we see a /, $m_l_p; print STDERR qq/we see a /, $m_l_f; if ($< != 0x0) { unless ( $m_l_f and ( $upx=($m_l_p->mode & 0100) or $gpx=($m_l_p->mode & 0010) ) ) { unless ( $upw=$m_l_p->mode & 0200 or $gpw=$m_l_p->mode & 00 +20 ) { warn q/warning: it is highly unlikely that you will be able to + /, q/store the MIRRORED.BY data file. You may have insufficient p +ermissions.\n/; } }

Failing tests on MSWin - HTML::Tidy

The distro's t/extra-quote.t file after I fixed it:
use warnings; use strict; # Response to an HTML::Lint request that it handle mishandled quotes. # See https://rt.cpan.org/Ticket/Display.html?id=1459 use Test::More tests => 4; BEGIN { use_ok( 'HTML::Tidy' ); } my $html = do { local $/ = undef; <DATA> }; my $tidy = HTML::Tidy->new; isa_ok( $tidy, 'HTML::Tidy' ); $tidy->ignore( text => qr/DOCTYPE/ ); $tidy->parse( "-", $html ); my @expected = split /\n/, q{ - (4:1) Warning: <img> unexpected or duplicate quote mark - (4:1) Warning: <img> escaping malformed URI reference - (4:1) Warning: <img> lacks "alt" attribute }; chomp @expected; shift @expected; # First one's blank sub strIfMSWin { return shift(@_) unless $^O =~ /M?S?Win/i; return substr( $_[0],-1 ) eq "\015" ? substr( $_[0],0,length($_[0])-1 ) : $_[0] } my @messages = $tidy->messages; is( scalar @messages, 3 ); my @strings = map { strIfMSWin($_->as_string) } @messages; is_deeply( \@strings, \@expected, "Matching warnings" ); __DATA__ <html> <title>Bogo</title> <body> <img src="foo alt=""> </body> </html>

As can be seen, the test fails because the set of expected messages is stored with any line ending. On MSWin the string returned has a ^C (CR, carriage return, ascii octal 015) on the end.

Here it is before fix:

use warnings; use strict; # Response to an HTML::Lint request that it handle mishandled quotes. # See https://rt.cpan.org/Ticket/Display.html?id=1459 use Test::More tests => 4; BEGIN { use_ok( 'HTML::Tidy' ); } my $html = do { local $/ = undef; <DATA> }; my $tidy = HTML::Tidy->new; isa_ok( $tidy, 'HTML::Tidy' ); $tidy->ignore( text => qr/DOCTYPE/ ); $tidy->parse( "-", $html ); my @expected = split /\n/, q{ - (4:1) Warning: <img> unexpected or duplicate quote mark - (4:1) Warning: <img> escaping malformed URI reference - (4:1) Warning: <img> lacks "alt" attribute }; chomp @expected; shift @expected; # First one's blank my @messages = $tidy->messages; is( scalar @messages, 3 ); my @strings = map { $_->as_string } @messages; is_deeply( \@strings, \@expected, "Matching warnings" ); __DATA__ <html> <title>Bogo</title> <body> <img src="foo alt=""> </body> </html>

#! /usr/bin/perl -w use strict; my $BeDugg= 0; my $uhome_CPAN_conf= q[/home/somian/.cpan/CPAN/MyConfig.pm]; my $_MyConfigPM= do { open local(*FH),$uhome_CPAN_conf or die "can't open: $!" ; sysread( FH, my $buf, -s FH ) ; $buf }; my( $befoD , $postD ) = ( [] , [] ); my( $p1 , $p2 ) = ( 0 , 0 ); my( $ConfH ) = ( [] ); my $linecnt = 1; EASYPIECES: for my $cln ( split qq[\n] => $_MyConfigPM ) { printf(STDERR "Line %3u:",$linecnt++) if $BeDugg; print STDERR "Found: \"$cln\" and " if $cln =~ /^\s*\$\QCPAN::Config\E\s+=/ and $BeDugg; do { print STDERR '$p1 holds value '.$p1.qq[\n] if $BeDugg; push @$befoD => $cln; next EASYPIECES } unless $p1 + $cln =~ /^\s*\$\QCPAN::Config\E\s+=/ .. $p1++; do { push @$ConfH => $cln; next EASYPIECES } unless ( $p2 + $cln =~ /^\s*\Q}\E\s*;\s*\Z/ .. $p2++ ); push @$postD => $cln } scalar @$ConfH and push @$ConfH => '};'; # Check data print STDOUT 'Part 1:', join(qq[\n], @$befoD, q[],q[]); print STDOUT 'Part 2:', join(qq[\n], @$ConfH),qq[\n\n]; print STDOUT 'Part 3:', join(qq[\n], @$postD, q[]); exit 0;
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (11)
As of 2014-09-18 21:58 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (125 votes), past polls