| Public Scratchpad | Download, Select Code To D/L |
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
:= 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:
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], $ +_, $$_ }'
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'
#!/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 }
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.
# Better write that asuse 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);
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.
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]; }
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).
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! ); }
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) }
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/] +);
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.
/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'
# 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;
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 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
--- 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/
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).
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". ;-)
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.
Code tested on: iX86-linux in sh shell with perl 5.10sub 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 }
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;'
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.
Insert disk and then do $ dmesg | tail -26
$ 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.
[[ ":$PATH:" == *:$dir:* ]] && PATH="$dir:$PATH "
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}
*** 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)
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.
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 }
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 **** #------------------
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() ."}" };
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
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;
#!/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;
sh-prompt $ perl -MText::Wrap='wrap,$columns' \ -MText::Textile=textile \ -lp000we \ 'INIT{$columns=78} s{\cM?\cJ} [ ]g; $_=wrap(q[],q[ ],textile($_)).$\;' DRAFT.TMP
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__
(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
$ 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
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
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
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
#! /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
" 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
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); }
Instructions for setting up cpan ...
$HOME/.cpan/CPAN/
perl -MCPAN -le 'CPAN::Config->init;$fulp=$INC{q[CPAN/Config.pm]}; pri +ntf qq[%-72s %o\n],$fulp,((stat $fulp)[2]& 07777 )'
my @Str = map { my $wholho=$_; s#^( (?:ht|f)tp:// ) ( [^/]+ )/.*$ #$2#x; [ $_,$wholho ] } @{$CPAN::Config->{urllist}};
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/; } }
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.
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;