My last PerlMonks posting was a CUFP that related very specifically to Microsoft Windows (but had the saving grace that it related to Free/Open-Source software insofar as I had written it in order to use Cygwin, that is, GNU-on-Windows, more effectively). So to be balanced and all, this submission for the perusal of the monkly Sis/Breth-ren relates to the very GNU-oriented developer's tool Autoconf and specifically to the use of macros in the authorship of those darned complex-icated configure files that are used to prepare the directed compilation of so many Open Source packages.

My CUFP this time is another very, very simple tool (because that's what I like most: the simple tools) that just does one thing. Before I explain what it does I'll just show the code:

#! /usr/bin/env perl

=for gpg
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

=cut

# update_acsite -- Place all m4 autoconf macros found in DIR into the 
+file named
# "acsite.m4" under ${PREFIX}/share/autoconf.

use warnings;
use strict;
use File::Glob qw{:glob};
use File::Spec::Functions qw{rel2abs splitpath file_name_is_absolute
                              catfile canonpath};
use vars qw{@MacrDa};

my $MyDir = $ARGV[0] || q|/usr/local/share/repository_ac_macros|;
my $OutFN = $ARGV[1] || q|/usr/local/share/autoconf/acsite.m4|;
my $OutDN = (splitpath($OutFN))[1];
# my $MyGlb = catfile($MyDir , "*.m4");

$MyDir = rel2abs( canonpath($MyDir) => '' ) if
   not file_name_is_absolute($MyDir);

die "This process cannot write to the dest directory: $!" if
   not ( -w $OutFN || (-d $OutDN && -w _) );
die "This indicated directory does not exist!: $!" if
   not chdir( $MyDir );

my @repos_macs = bsd_glob( '*.m4' ,
 GLOB_ERROR | GLOB_MARK | GLOB_NOCASE | GLOB_TILDE | GLOB_NOSORT
  );

if (@repos_macs)  {
  foreach my $macfile_data (@repos_macs) {
    my $fsz = -s $macfile_data;
    (my $fln = <<"!ROBUSTO!" ) =~s/^\s*//mg;
    
      dnl ------------------------------------------------------------
+-
      dnl The next file added $fsz bytes to this collection.
      dnl  file: $macfile_data
      dnl ------------------------------------------------------------
+-

!ROBUSTO!
    open IFH,$macfile_data or
      die "Failed to open() \"$macfile_data\" ";
    read(IFH, my $data, $fsz);
    $data or die "Could not read any data from \"$macfile_data\"";
    close IFH;
    push @MacrDa , qq{\n\n}, $fln , $data;
  }
  open OFH,">$OutFN" or die "Cannot open() the outfile \"$OutFN\" -- $
+!";
  print OFH @MacrDa;
} else {
  my $me = (splitpath($0))[3];
  print STDERR <<"!CLEMENTINE!";
$me terminated because there were no macro *.m4 files found in the ind
+icated
or default directory location. Please check your arguments and try aga
+in.
!CLEMENTINE!
}

__END__

=begin gpg

-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.0.6 (GNU/Linux)
Comment: For info see http://www.gnupg.org

iD8DBQE/FWU8BXOj2U4kTqYRArKyAJwKJ/9gmyof0MZJ+Ao2TQ+rcPEwYQCdEmdC
5/oKZKbs5XfVaHlvV1r3h+0=
=TX52
-----END PGP SIGNATURE-----

=end gpg

This Program is Free Software,
(C)2003 Soren Andersen <somian -AT- pobox -DOT- com>
it may be used under the same terms as Perl itself.
[download]

Now what's going on there is this. Being the kind of laid-back mellow dude that I am, I recently surfed over into the two AC Autoconf Macro archive sites (who are:

• http://www.gnu.org/software/ac-archive/
• http://ac-archive.sourceforge.net/

Autoconf (versions going back how far?) will add any macros found in a file named acsite.m4 located in the top Autoconf "lib" (conceptually) directory. In the case of my own recent site-local (manually installed) Autoconf that is in

/usr/local/share/autoconf

Autoconf m4 macros are conceptually very much like Perl modules. They extend the functionality of Autoconf in an analogous fashion and embody the primary Virtue of code reuse. My simple Perl tool just slurps in all the .m4 files it finds in the given dir and writes them all out to the single properly named file (the user is responsible for telling the program where the file should be be properly placed). There's not much Perl there but there was a gap in the convenience of the AC Archive concept that I thought Perl should be the one to fill. And yes, the Archive(s) offer all the macros bundled into downloadable archive files, and that would be perhaps another shortcut. I felt that I didn't want ALL the macros but just the ones that seemed useful or interesting to me, and I can always go back and add more later. Perl will take care of adding them to my working Autoconf system: I can re-run update_acsite anytime I want and it will just Do The Right Thing. IMHO, this comprises a CUFP.

PS:	Q: OK, what's up with the signed code? A: See perlsign. Another CUFP, IMHO ;-)

Hi, Monks. I've been trying to add a MS Windows shell context entry to enable me to alternate-mouse click on a file or folder in Windows Explorer GUI, and have the file name as Cygwin sees it placed on the Clipboard. Because the Perl tool I wrote to help me accomplish this was used it for enhancing my enjoyment of Cygwin, this qualifies in my book as a CUFP.

This (context-menu access to the Cygwin-mode filename) has been invented before, but TTBOMK nobody has shown how to make it portable across different people's systems without editing the .reg file manually.

BTW, to get this to work I used what's already defined in my master Windows ENV, a variable %CYGROOT% which points to the MSWin32 mode path spec of the top of my Cygwin installation tree.

Substitute your own different software installation needs and you may agree that this could be pretty useful once in a while.

Update:
Except that you cannot get Win95, 98, prob. ME to import such a key value-data type into the Registry. I have just found out that the inferior REGEDIT tool supplied with these inferior versions of Windows is incapable of doing this. The later NT4/5-derived Windows can do so.

There's really some Perl coming soon, I promise. I just dislike very incomplete and puzzling explanations that people sometimes give about software I am unfamiliar with, that leaves me totally in the dark about why they bothered. So here's the rest of the set-up...

There are several "DATA TYPES" (Microsoft terminology) possible for MS Win Registry entries. The type most of us would call a "C string" is called a REG_SZ and is formatted as a simple string (but with some complex quoting and escaping rules). There's a logically and semantically (since "SZ" is is Microsoft-speak for "null-terminated string") related Registry data type called a REG_EXPAND_SZ that can contain a level of "indirection" in the form of a system variable that can be resolved at the time of use of the entry. For example:

   "SoMeThIng"="%WINDIR%\\system32"

  "SoMeThIng"=hex(2):22,25,57,49,4e,44,49,52,25,5c,5c,73,79,73,74,65,6d,33,32,22,00

UPDATE: Ooops. I forget to chomp() the newline before encoding it when taking data from <STDIN>. Fixed now. Well, classic CRLF vs. LF gotcha. NOW is fixed.

UPDATE: Ooops, again. Not showing sterling recall of my sprintf() style ;-). Need to pad to two tokens per byte, format: "%02x". Debugging continues.

UPDATE (July 06, 2003): Apparently, REGEDIT5 (e.g., on Win XP) exports such REG_EXPAND_SZ data with a null byte 00 after every real byte. These tools here will clearly fail to create or decode such a stream and therefore are limited to handling REGEDIT4 -style .REG files.

#!/usr/bin/perl -w
# "REGexpandSZgen" - generate the formatted hex string from a normal
# ascii input string- for a REGEDIT file; to enter a REG_EXPAND_SZ
# data-type entry into the MS Windows Registry.

use strict;
my $encme = pop(@ARGV) || <STDIN>;
   $encme =~s% (\x{0d}|\x{0a}{1,2})\Z
            %%x;
if($encme =~m{^("[^"]+"|\@)\=(.*)$})  {
 # " does not appear where "entry"= @
    $encme = [$1, $2];
}
my $cvtd = [ map { sprintf "%02x",ord } split('',
                   ref $encme ? $encme->[1]:$encme) ];
if(not $ARGV[0])  {
    print '',  (ref $encme ? "$encme->[0]=":""),
               "hex(2):", join(',',@$cvtd,'00'), "\n";
} else {
  # any prepended arg causes us to 
  # debug / test / verify the string.
    print "\n IN: ",(ref $encme ? $encme->[1]:$encme),"\nOUT: "
    , pack("c*", map(hex, @$cvtd[0..(@$cvtd - 0x1)]))
    , "\n";
}

__END__

This Program is Free Software,
(C)2003 Soren Andersen <somian -AT- pobox -DOT- com>
it may be used under the same terms as Perl itself.
[download]

#! /usr/bin/perl -wl
# "REGdecodeSZ" - decode Microsoft .REG -style null-terminated
#   strings encoded as comma-delimited sequences of hex bytes.
use strict;
my ($instr, @barr);
chomp($instr = <STDIN>) 
   unless( $instr = $ARGV[0x0] );
my $to = 0x1 * (@barr=split q/,/ , $instr);
print join '',
    (
       map { chr hex } @barr[
               0x0 ..  ($to ? $to - 0x2
                            : $to) ]
    );
__END__

This Program is Free Software,
(C)2003 Soren Andersen <somian -AT- pobox -DOT- com>
and it may be used under the same terms as Perl itself.
[download]

I haven't shown all the pieces -- particularly the .REG file which actually modifies the Registry, because that isn't Perl and doesn't really pertain to the broader concept. The reader who is left wanting a look at the rest of the pieces of this, my excuse-for-the-evening to crank out some Perl hacks, is encouraged to check the Cygwin mailing List archives (from the Cygwin site) for the recent and many past discussions relating to this specific idea.

This special-purpose script has been updated on Thurs Sep 13, 2001 to reflect improvements needed to make it more compatible with the ugly realities of MS Windoze OS's: the code using a shell file descriptor redirect 2>&1 has been conditional'd-out for users of non-NT systems (which are far more seriously broken). The code has now been used and tested on Win98.

  Soren Andersen

Original description:

I think this is a pretty good CUFP, if somewhat esoteric

Pegasus Email for Win32 is a widely used and fine zero-cost email client. It has the feature that it can load a file at run time which contains an arbitrarily large collection of email .sigs, and include these into outgoing messages randomly. In order to set it up for Pegasus to do this, one must manually create the binary "RQUOTES.PMS" file and place it one's Pegasus user directory. This file is a compiled resource file produced from a human-readable text file using the resource compiler <CITE>rescom.exe</CITE>, included in Pegasus Email.

Further steps are also required on the Pegasus menu level and although not difficult to accomplish, rigorously detailing them here is beyond the scope of this posting and OT for this Monastery. That info is available in the Pegasus documentation.

The program requires the endlessly enjoyable and useful Perl module Text::Autoformat (CPAN). Naturally as it is only relevant to the Win32 Perl user group, it also uses Win32:: modules. File::Compare is also used. The code is rough and user convenience hasn't been dealt with; lots of manual setup will be needed.

Intrepid (Soren)

#!perl -w

#  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# "MakePSigs.p" is a Perl-on-Win32 program for managing the auto-
# generation of a random .sig compiled resource file that is used by
# Pegasus Email for Win32.
#    Copyright (c) 2001 Soren Andersen. All Rights Reserved.
#  This program is Free Software and may be used, copied or modified
#  subject to the same terms as Perl itself.
#    L/M: Thu Sep 13 18:28:00 2001
#
#  sample invocation:
#  $> MakePSigs.p "soren" "E:/data/var/MBOXEN/RQUOTES.PMS"
#  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
use Text::Autoformat;
use Win32;
use Win32::FileOp;
use Win32::Process;
use File::Compare qw{cmp};
use strict;
use vars qw{ $QuoSrc $QuoteFile $Backup $WrkDir
               $RPG_rsc $Whatever $ShortQFname @Msgs
              @Quotes $TodayNow };
use subs qw{ &EntryFormat &ErrorReport &UnDOS &ReDOS};
#  DO USER CONFIGURATION OF PATHS HERE
$QuoSrc   = 'E:/data/textfile/email_sigs/Philosophic_random_src.txt';
$WrkDir   = 'E:/Pegasus/Resource';
#  "Rquotes.pms" goes where your Pegasus user files live:
$RPG_rsc  = ($ARGV[1])? $ARGV[1] : 'G:/Pegasus_user/Rquotes.pms';
#  DONE WITH USER CONFIGURATION

$Whatever = '';
my $pegasus_user = ($ARGV[0])? lc $ARGV[0] : 'default';
($QuoteFile,$Backup) = ( ReDOS($WrkDir).'\Rquotes.'.$pegasus_user,
                  ReDOS($WrkDir).'\Rquotes.'.$pegasus_user .q[BU]);
open(QRAW, qq[<$QuoSrc]) or
  die autoformat(<<OUTPUT
 There is something wrong, I could not open() the quotations
 text source file "$QuoSrc", are you sure it is really there? -
   "$!"
OUTPUT
, {all =>1});

sub UnDOS { my $pathspec_expression = shift;
                    $pathspec_expression =~s@\\@/@g;
                 return $pathspec_expression; };
sub ReDOS { my $pathspec_expression = shift;
                    $pathspec_expression =~s@/@\\@g;
                 return $pathspec_expression; };

$ShortQFname = UnDOS( Win32::GetShortPathName(
                   UnDOS($QuoteFile) ) );
print STDERR qq[\n DIAGN: "$ShortQFname" is file name\n];
my $block = 0;  my $current = [];
 while (<QRAW>)   {
    if (/^\<\<$/ ) {
      $Quotes[$block++] = $current;
      undef $current;
      (eof)? last:next;
    }
  push @$current, $_;
 }
close ( QRAW );
 foreach my $rand_sig (@Quotes)   {
    print STDERR qq[\n], &EntryFormat($rand_sig);
 }
print STDOUT qq{\n}, '-' x 58, qq{\nWould you like to add these},
      qq{ quotes to the Random Philosopical Quote (RPQ) file?\n};
if (<STDIN> =~/Y(?:es)?/i)        {
   CopyEx($QuoteFile => $Backup,
       FOF_ALLOWUNDO | FOF_FILESONLY) if -e $QuoteFile;
   open RPQ, qq[> $QuoteFile] or die $!;
   $TodayNow = localtime(time);
   print RPQ<<FINI;
#  file automatically generated, last revision on $TodayNow
headers off       #  Ignore this command
symbols off       #  Ignore this command.

FINI

   foreach my $rand_sig (@Quotes)   {
      print RPQ  qq[\n], &EntryFormat($rand_sig);
   }
 close( RPQ ) or die $!;

 chdir "$WrkDir" or die
        qq[\nCould not cd into wrkng Peg dir "$WrkDir":\n$!];

if (Win32::IsWinNT())   {
 (my $piD = open RPQCC, ReDOS($WrkDir).q[\Rescom.exe].
            qq[ $ShortQFname 2>&1  |]) or
               die qq[We had pipe-open() trouble. ],
                   qq[Could not open "rescom.exe":],
                   qq[\n$!];
    push @Msgs, qq[\n\nMessages from the resource compiler:\n\n];
      if (defined $piD)      {
          while (<RPQCC>)      {
             push @Msgs, '  '. $_;
                $Whatever = $1 if (m@Created\s resource\s file\s
                    ([A-Z]:/.+/Resource/RQUOTE.+\.rsc) \:@xi);
          }
      }
  close( RPQCC ) or warn qq[Cannot close the pipe-handle?!:\n $?];
} elsif (Win32::GetOSVersion()) # return values: Win9x 1, WinNT 2
  {
 select STDERR; $|++;
 select STDOUT; $|++;
 my ($spawnd, $pid, $exitcode);
  Win32::Process::Create($spawnd, q[RESCOM.exe],
         "RESCOM $ShortQFname -w -a", 0, CREATE_NEW_CONSOLE, ".")
                                             || die ErrorReport();
    if (  $pid = sprintf(q[%#8X],$spawnd -> GetProcessID())  )  {
        print STDERR qq[\nThe RESCOM.EXE process was successfully ],
                     qq[started and is running as PID $pid\n];
         $spawnd -> Wait(3000);
         $Whatever = q[RQUOTE~1.RSC];
         $spawnd -> GetExitCode( $exitcode );
        my $rverb = substr (Win32::FormatMessage($exitcode << 256),
               0, -2);
         $rverb = ($rverb)? $rverb : q[OK];
        print STDERR qq[\n Exit status for the RESCOM process:    ],
                       ( $exitcode << 256 ), qq[ ("${rverb}")\n];
    } else {
       warn autoformat( qq[\nThe RESCOM.EXE process was ].
               qq[ not started right, no pid returned ...] );
    }
  }

 print STDERR @Msgs,qq[Done compiling, did it go satisfactorily?\n];
     if (<STDIN> =~/Y(?:es)?/i and $Whatever)   {
           $Win32::FileOp::ProgressTitle =
            qq[Copying Pegasus resource file $Whatever to user dir];
           CopyConfirm("$Whatever" => "$RPG_rsc") or
      die qq[Copy .RSC to Pmail user dir failed:\n$^E \n($!)];
           if ( cmp( $Whatever,$RPG_rsc ) )  {
              warn qq[Copy .RSC to Pmail user dir .PMS failed:\n],
       qq[the files are not the same];
           } else {
             print STDERR qq[\nDone! -- $RPG_rsc is ],
                   int(-M $RPG_rsc), qq[ days old.\n];
           }
       } else {
   print STDERR qq[\nYou've elected to abort the procedure? OK.\n];
   exit 2;
       }
} # END IF STDIN =~"yes"
exit 0;


#   ================  SUBS  ===================

sub EntryFormat  {

my $sigquote = shift;
my @sigquote =  do  {
     split qq[\n],autoformat(join(q[   ],'',@$sigquote),
          { all =>1, left =>5, right =>68} );
      };
@sigquote = map{
    s@\"@'\"'@ge if length >= 0;
    $_ .= '\n' if length >= 0;
      if ($_ !~/^$/) {$_;} else {'';}
            } @sigquote;
@sigquote = map{$_ = qq["$_",\n];} @sigquote;
my $final = join '', @sigquote;
my $entry=<<DONEDEAL;
text x
   {
$final
   };

DONEDEAL
return $entry;
}


sub ErrorReport{
        print Win32::FormatMessage( Win32::GetLastError() );
}


=pod

=head1 Name

MakePSigs

=head1 Synopsis

C<perl MakePSigs.p [Pegasus login name] [pathspec for outputfile]>

=over 3

The Pegasus Email login name is optional; if not used, the script
will paste the suffix ".default" onto the end of generated
filenames. You'd want to name the source textfile (see below)
appropriately, then, B<before> running the script.

=back

=head1 Description

B<Pegasus Email for Win32> is a widely used and fine zero-cost email
client. It has the feature that it can load a file at run time which
contains an arbitrarily large collection of email .sigs, and include
these into outgoing messages randomly. In order to set it up for
Pegasus to do this, one must manually create the binary "RQUOTES.PMS"
file and place it one's Pegasus user directory. This file is a
compiled resource file produced from a human-readable text file
using the resource compiler F<rescom.exe>, included in
"Pegasus Email for Windows."

Further steps are also required on the Pegasus menu, namely setting
a signature choice with the characters `B<~!>' (B<tilde-bang>) at
the place where you want the randomely-chosen quote to be inserted.
See the Pegasus Email for Windows documentation.

The program requires the endlessly enjoyable and useful Perl module
F<Text::Autoformat> (CPAN). Naturally as it is only relevant to the
Win32 Perl user group, it also uses F<Win32::> modules.
F<File::Compare> is also used. The code is rough and user
convenience hasn't been dealt with much; some attention to manual
setup will be needed.

=head2 The Source file Format

The script reads in from a source file, a text file with a format
along these lines:

 "The reasonable man adapts himself to the world ...
 the unreasonable man persists in trying to adapt the world to himself
+."

 "Therefore, all progress depends on the unreasonable man."

                              -- George Bernard Shaw

 <<
 "Kindness is the flower of strength."

            -- Jose Marti, Hero of Cuban Independence

 <<

The example file above has been indented in this POD documentation
to preserve formatting; in actual use there would be no left margin.
The E<lt>E<lt> characters on a line alone is the delimiter between
quotes. Make sure the last quote in the file is followed by the
delimiter I<or the script will break>.

=head2 from Pegasus header:
    ##   Compile this source using ResCom.exe, by issuing the
    ##   command "ResCom RQUOTES.R", then copy the resulting
    ##   RQUOTES.RSC file into your home mailbox as RQUOTES.PMS.
    ##
    ##   So, the sequence of commands looks like this:
    ##
    ##      C:\PMAIL> rescom rquotes.r
    ##      C:\PMAIL> copy rquotes.rsc f:\mail\9000001\rquotes.pms


=head1 AUTHOR

Soren Andersen E<lt>libertador@flashmail.comE<gt>

=for html

<A HREF="mailto:libertador@flashmail.com">libertador@flashmail.com</A>

=head1 COPYRIGHT

Copyright (c) 2001 Soren Andersen. All Rights Reserved.
This program is Free Software and may be used, copied or modified
subject to the same terms as Perl itself.


=cut
[download]

A little tool for developers.

Updated: 22 Jan 2004 — Major re-write. Now named gcc-spcdmp

No longer relies on the deprecated (now) File::PathConvert module, only on core Perl libraries. This is considerably better code than I wrote in 2000 when first posted to PM.

Links provided for reader convenience:

#!/usr/bin/env perl
eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
    if 0; # not running under some shell

package main;
###
# gcc-spcdmp - cleans up output from spec check on GNU C compiler suit
+e.
###

##     Last modified: 22 Jan 2004 16:00:52

# (c)2000,2004 Soren Andersen
# Kode Kudos to Shigio Yamaguchi & Barrie Slaymaker.



#======================= cvs/rcs internal data =======================
+======#
## $Source: /usr/src/repositories/cvs/perl-proj/devtools/gcc-spcdmp,v 
+$
##    $Date: 2004/01/22 20:51:48 $
##    $Revision: 1.4 $    ##
#=====================================================================
+======#

require 5.005;  # qr// operator.
use strict;
import File::Cleanspec 'concise'; # use File::Cleanspec;
use Env ('SHELL','COMSPEC');
use Text::Wrap ('wrap','$columns');
use Pod::Usage 'pod2usage';
BEGIN {
  my( $argC,$argN ) = ( +@ARGV , $ARGV[$#ARGV] );
  if( grep { $_ eq lc($argN) or $_ eq substr lc($argN)=>1 }
      qw/ -h -u -man -help -usage / )    { pod2usage(-verbose => 2) }
  elsif ($argC > 1 )                     { pod2usage(1) }
}


###
# included module code, see File::Cleanspec which may be released
# on CPAN someday (by the author of this program).
###

package File::Cleanspec;
require 5.002;

use strict;

BEGIN {
    use Exporter ();
    use vars qw (@ISA @EXPORT);
    @ISA         = 'Exporter';
    @EXPORT      = 'concise';
}

# set up global lexicals & their default values
my $fstype           = 'Unix' ;
my $sep              = '/' ;
my $sepRE            = '/' ;
my $notsepRE         = '[^/]' ;
my $volumeRE         = '' ;
my $directoryRE      = '(?:(?:.*/(?:\.\.?$)?)?)' ;
my $isrootRE         = '(?:^/)' ;
my $thisDirRE        = '\.' ;
my $parentDir        = '..' ;
my $parentDirRE      = '(?:\.\.)' ;
my $casesensitive    = 1 ;
my $idempotent       = 1 ;

# global regexen used in the indicated routines.  These
# are initialized by setfstype, so they don't need to be rebuilt each 
+time
# the routine that uses them is called.

# Used in realpath() to split filenames.
my $bnsRE ;

# This RE matches (and saves) the portion of the string that is just b
+efore the beginning of a name
my $begonRE ;

# This whopper of an RE looks for the pattern "name/.." if it occurs
# after the beginning of the string or after the root RE, or after a s
+eparator.
# We don't assume that the value of $isrootRE has a trailing separator
+.
# It also makes sure that we aren't eliminating '../..' and './..' pat
+terns
# by using the negative lookahead assertion '(?!' ... ')' construct.  
+It also
# ignores 'name/..name'.
#
my $nspRE ;

#
# Matches '..$', '../' after a root
my $leading_parentRE ;

#
# Matches things like '/(./)+' and '^(./)+'
#
my $dot_sep_etcRE ;

#
# Matches trailing '/' or '/.'
#
my $trailing_sepRE ;


# based on "setfstype" in File::PathConvert by
#        Shigio Yamaguchi & Barrie Slaymaker

#******************************************************************
sub _setfstype                    #********************************
#******************************************************************
{
   my $osname = shift ;

   # Find the best match for OS and set up our atomic globals accordin
+gly
   if ( $osname =~ /^(?:(ms)?(dos|win(32|nt)?))/i )
   {
      $fstype           = 'Win32' ;
      $sep              = '/' ;
      $sepRE            = '[\\\\/]' ;
      $notsepRE         = '[^\\\\/]' ;
      $volumeRE         = '(?:^(?:[a-zA-Z]:|(?:\\\\\\\\|//)[^\\\\/]+[\
+\\\/][^\\\\/]+)?)' ;
      $directoryRE      = '(?:(?:.*[\\\\/](?:\.\.?$)?)?)' ;
      $isrootRE         = '(?:^[\\\\/])' ;
      $thisDirRE        = '\.' ;
      $parentDir        = '..' ;
      $parentDirRE      = '(?:\.\.)' ;
      $casesensitive    = 0 ;
      $idempotent       = 1 ;
   }
   elsif ( $osname =~ /^MacOS$/i )
   {
      $fstype           = 'MacOS' ;
      $sep              = ':' ;
      $sepRE            = '\:' ;
      $notsepRE         = '[^:]' ;
      $volumeRE         = '(?:^(?:[^:]+:)?)' ;
      $directoryRE      = '(?:(?:.*:)?)' ;
      $isrootRE         = '(?:^(?=[^:].*:)?)' ;
      $thisDirRE        = 'cantpossiblymatchthis' ;
      $parentDir        = '' ;
      $parentDirRE      = '(?=(?<=:):)' ;
      $casesensitive    = 0 ;
      $idempotent       = 0 ;
   }
   elsif ( $osname =~ /^VMS$/i )
   {
      $fstype           = 'VMS' ;
      $sep              = '.' ;
      $sepRE            = '[\.\]]' ;
      $notsepRE         = '[^\.\]]' ;
      # volume is node::volume:, where node:: and volume: are optional
+ 
      # and node:: cannot be present without volume.  node can include
      # an access control string in double quotes.
      # Not supported:
      #     quoted full node names
      #     embedding a double quote in a string ("" to put " in)
      #     support ':' in node names
      #     foreign file specifications
      #     task specifications
      #     UIC Directory format (use the 6 digit name for it, instead
+)
      $volumeRE         = '(?:^(?:(?:[\w\$-]+(?:"[^"]*")?::)?[\w\$-]+:
+)?)' ;
      $directoryRE      = '(?:(?:\[.*\])?)' ;

      # Root is the lack of a leading '.', unless string is empty, whi
+ch
      # means 'cwd', which is relative.
      $isrootRE         = '(?:^[^\.])' ;
      $thisDirRE        = '\[\]' ;
      $parentDir        = '-' ;
      $parentDirRE      = '-' ;
      $casesensitive    = 0 ;
      $idempotent       = 0 ;
   }
   elsif ( $osname =~ /^URL$/i )
   {
      # URL spec based on RFC2396 (ftp://ftp.isi.edu/in-notes/rfc2396.
+txt)
      $fstype           = 'URL' ;
      $sep              = '/' ;
      $sepRE            = '/' ;
      $notsepRE         = '[^/]' ;
      # Volume= scheme + authority, both optional
      $volumeRE         = '(?:^(?:[a-zA-Z][a-zA-Z0-9+-.]*:)?(?://[^/?]
+*)?)' ;

      # Directories do _not_ include the query component: we pretend t
+hat 
      # anything after a "?" is the filename or part of it.  So a '/'
      # terminates and is part of the directory spec, while a '?' or '
+#'
      # terminate and are not part of the directory spec.
      #
      # We pretend that ";param" syntax does not exist
      #
      $directoryRE      = '(?:(?:[^?#]*/(?:\.\.?(?:$|(?=[?#])))?)?)' ;
      $isrootRE         = '(?:^/)' ;
      $thisDirRE        = '\.' ;
      $parentDir        = '..' ;
      $parentDirRE      = '(?:\.\.)' ;
      # Assume case sensitive, since many (most?) are.  The user can o
+verride 
      # this if they so desire.
      $casesensitive    = 1 ;
      $idempotent       = 1 ;
   }

 # Now assemble our composite regexps
   $bnsRE   = '^(.*)'. $sepRE . '('. $notsepRE .'*)$' ;
   $leading_parentRE  = '('. $isrootRE .'?)(?:'. $parentDirRE . $sepRE
+ .')*'
                                                 .'(?:'. $parentDirRE 
+.'$)?' ;
   $trailing_sepRE    = '(.)' . $sepRE . $thisDirRE . '?$' ;
   $begonRE = '(?:^|'. $isrootRE .'|'. $sepRE .')' ;

   $dot_sep_etcRE     = 
      '(' . $begonRE . ')(?:' . $thisDirRE . $sepRE . ')+';
#---------------------------------------------------------------------
+-
 # in english:
 # nothing (start of string) or root or sep (captured)
 #    IF FOLLOWED BY something that is NOT . or .. FOLLOWED BY / (zero
+-width lookahead),
 #    FOLLOWED BY something that isn't / , FOLLOWED BY / , FOLLOWED BY
+ .. , FOLLOWED BY
 #    either / or nought (end of string).
   $nspRE   = '('. $begonRE .')'
      . '(?!(?:'. $thisDirRE .'|'. $parentDirRE .')' . $sepRE .')'
      . $notsepRE .'+' . $sepRE . $parentDirRE 
      . '(?:'. $sepRE .'|$)' ;
#---------------------------------------------------------------------
+-
      return $fstype ;
}

# based on  "regularize" from File::PathConvert
#         by Shigio Yamaguchi & Barrie Slaymaker
# (but note reordered substitutions).

#******************************************************************
sub concise                       #********************************
#******************************************************************
{
    local $^W = 1;
    my $in = shift @_ ;

    # Combine idempotent separators.  Do this first so all other REs o
+nly
    # need to match one separator. Use the first sep found to preserve
    # backward slashes on Win32.
    $in =~ s/($sepRE)$sepRE+/$1/g if $idempotent ;

    # We do this after deleting redundant separators in order to be co
+nsistent.
    # If a Win32 path ended in \, we want to be sure that \ is returne
+d, not /.
    my $trailing_sep = ($in =~ /($sepRE)$sepRE*$/) ? $1 : '';
   
    # Get rid of ./ in '^./' and '/./'
    $in =~ s/$dot_sep_etcRE/$1/g ;

    # Get rid of trailing '/' and '/.' unless it would leave an empty 
+string
    $in =~ s/$trailing_sepRE/$1/ ;

 # Delete all occurences of 'name/..(/|$)'.  This is done with a while
 # loop to get rid of things like 'name1/name2/../..' ... we choose th
+e pattern
 # name/../ as the target instead of /name/.. so as to preserve 'rootn
+ess'.
 # see explanation of this regexp "$nspRE" above.
    do {} while $in =~ s/$nspRE/$1/g ;

    # Get rid of '../' constructs from absolute paths
    $in =~ s/$leading_parentRE/$1/ if ( $in =~ /$isrootRE/ ) ;

    # Restore trailing separator if it was lost. We do this to preserv
+e
    # the 'dir-ness' of the path: paths that ended in a separator on e
+ntry
    # should leave with one in case the caller is using trailing slash
+es to
    # indicate paths to directories.
    $in .= $trailing_sep
        if ( $trailing_sep ne '' && $in !~ /$sepRE$/ ) ;

    return $in ;
}


# Executed once when module is loaded. No "1;" at last line because we
+ *DON'T* WANT
# perl to succeed in loading the module if this sub fails. IOW, this s
+hould always
# return true anyway.

my $detected = _setfstype($^O);

###
# end of included module (package space) "File::Cleanspec"
###



package main;

my $setfstype = \&File::Cleanspec::_setfstype;
$columns = 76;

my( $specHd , $fndelim , $fh , $bg2en , @bconfig
    , $bctarget , $rootish , $realvol , @goods , %compo );
my $divdr     = qq(\n ) . '-' x $columns . qq(\n);
my $cntdefs   = 0;
my $sanify    = {};
my $cppdefchr = qr{ [-_=0-9a-zA-Z]+ \s* }x;
my $flegalchr = q{[-.\w]};
my @intro     = (qq{\n  GCC component tools:});
my $gcc_cmd_path = 'gcc';
do { eval "select $_ ; $| = 1 ;" } foreach qw{STDERR STDOUT};
$specHd = $fndelim = '/';

if    ($ARGV[0] and $ARGV[0] eq '-demo')
{ # demo
    print STDERR "            ***     D E M O     ***\n";
    $fh = \*DATA;
    $specHd = '[A-Z]:';
    $fndelim  = quotemeta '\\';
    $setfstype->( 'mswin32' ) eq 'Win32' or die "Cannot set fstype";
}
elsif  # we supply an alternate name for gcc invocation:
      ($ARGV[0])
{
    $gcc_cmd_path = shift @ARGV;
    $gcc_cmd_path =~ s@\\@/@g;
}

if   ( (not $SHELL) or
         (not $ARGV[0]
        and
                ($COMSPEC &&
         $COMSPEC=~m@(?:CMD(?:\.EXE)?|COMMAND(?:\.COM)?)@i
                and
            eval{
            my $prb=`gcc -dumpmachine`;
            1 if $prb =~/\-mingw/m;
            }
        ))
     )
{
    $setfstype->( 'mswin32' ); 
    $specHd = '[A-Z]:';
    $fndelim  = quotemeta '\\';
}
elsif  ($^O =~ /cygwin/ and
        $SHELL and $SHELL =~ m% [[:alpha:]]{0,2}sh %x)
{
    $specHd = $fndelim = '/';
    if   ($ENV{'CYGROOT'})
    {
    $rootish = $ENV{'CYGROOT'};
    }
    else
    {
    chomp( $rootish = `cygpath -wa /` );# print qq(\n My CygROOT: $roo
+tish\n);
    }
    $realvol = substr( $rootish, 0, 2 );
    $rootish = quotemeta( substr( $rootish, 3 ));
    $setfstype->( 'unix' );
}


if  (! defined $fh)
{
    die "drat, no touch!" if system qq(touch foo.c);
    open SHPIPE, qq(2>&1  $gcc_cmd_path --verbose -c foo.c | )
    or die qq(We haven't got a good open() here?!\n$!);
    $fh = \*SHPIPE;
}

my $re_FNstart = qq%$specHd$fndelim?$flegalchr+$fndelim\\S+%;
# print STDERR "RE for paths is \"$re_FNstart\"\n";

while (<$fh>)
{
   last if /\A\s*\Z/ and eof;
   my( $path , $processed , $reduced , $prepath
      , $whol , $pstpath , $predef  , $pstdef )
        = map ('',(1 .. 8));
   $bg2en = 0;
# s#/#\\#g;  # for mswin-dos
   if  ( /\sas(?=\s-(V|o))/ or /$re_FNstart(?=\s)/o )
             # May need some work?
  # the above won't tolerate spaces in path specifications
  # (Windoze users take note!).  /^(?<=\s)$specHd $flegalchr+ $fndelim
+ \S(?=\s) /x
   {
       chomp($path = $&);
       next if  /as -o/ or q'"' eq substr($path, -1);
       chomp($whol = $_);
       $prepath = $`  if $`;
       $pstpath = $'  if $' and not m@\-(?:D|A)$cppdefchr@;
       $bg2en   = 1   if $whol =~/\Q$path\E/;
       unless ($specHd eq '/')
       {
       $reduced = concise( $path );
     # debugging stuff
       print STDERR qq(\n * Oops, "concise()" failed: ),
        $reduced, qq(\n   from path: $path\n)
              if $reduced =~m@\Q$fndelim\E\.\.\Q$fndelim@;
       }
       elsif  ($rootish)
       {
       my $cpath = concise( $path );
       chomp( $reduced = `cygpath -wa $cpath` );
       my $winpath = $reduced;
       $reduced =~s@\\@$fndelim@g;
       $reduced =~s@ $realvol (?:$fndelim$rootish)? @@x;
       $sanify->{$reduced} = $winpath;
       print STDERR qq(\n * Oops, failed: ),
       $reduced, qq(\n   win path: $winpath\n) if $reduced =~m@$fndeli
+m\.\.$fndelim@;
       }
       else  # other uni*-like platforms .. sorry MacPerl-ites ;-(
       {
       $reduced = concise( $path )
           or warn qq(\nTrouble from path spec "$path"\n);
       }

       if ( $pstpath =~ m@ -lang-c -v @
         or     /-(?:D|A)$cppdefchr/ )
       {
           my @defin = qq(\n);
           my @other = ();
           push @defin, grep  /\-(?:D|A)$cppdefchr/, split /\s+/, $_;
           push @other, grep !/\-(?:D|A)$cppdefchr/, split /\s+/,
                     substr($_, index ($_ => '-v'));
           $predef = $` if $`;
           $pstdef = $' if $';
           push @goods , qq(\n), qq(\n)
              , 'Default/automatic preprocessor-defined symbols:'
              , (map { (sprintf( "\n  [% 2u] ",
                           ++$cntdefs). $_) if $_;
                 } grep {s@\s+\Z@@ || 1}@defin)
              , qq(\n\n);
           if (@other)
           {
           my $bopeep = 0;
           push @goods, "Other CPP default conditions: ";
           push @goods, map { s%[/\\]+%$fndelim%go;
                     /-iprefix/ .. $bopeep++ ? 
               ($bopeep ? concise($_) : $_) : "" }@other;
           push @goods, qq{\n};
           }
       }
       my  $comp;

       if   ($reduced =~ m@cpp  (?:\.exe|0)?   \Z@x) { $comp = 'CPP' }
       elsif   ($reduced =~ m@cc1 (?:\.exe)?   \Z@x) { $comp = 'CC'  }
       elsif   ($reduced =~ m@as  (?:\.exe)?   \Z@x) { $comp = 'AS'  }
 # -------------------------------------------------------------------
+-
       if ($comp)  { $compo{$comp}  = qq|$divdr  $reduced| ; next }
 # -------------------------------------------------------------------
+-
       unless ($rootish)  { $_ = $prepath . $reduced . $pstpath }
       else
       {
       $_ = $prepath . $reduced;
       $_ .= qq|\n     ** aka |. $sanify->{$reduced} .qq| **|
           if exists $sanify->{$reduced};
       $_ .= $pstpath;
       }
    
       $processed  =  $_;
       $_ = $whol .qq(\n);
   }

 # -------------------------------------------------------------------
+-
   my $comv;
   if      (/^GNU CPP version/)                  { $comv = 'CPP' }
   elsif   (/^GNU C version/)                    { $comv = 'CC'  }
   elsif   (/^GNU assembler version/)            { $comv = 'AS'  }
   elsif   (/^\s*compiled by .+\.\d\.\Z/)        { $comv = 'CC'  }
 # -------------------------------------------------------------------
+-
   if ($comv)
   {
       my $parent = /\Q(cpplib)\E/ ? 'CC' : $comv;
       chomp;
       $compo{$parent} .= ($compo{$parent} ? qq[\n] : q[]);
       if (substr( $compo{$parent}, -5, 3 ) ne '---') {
       $compo{$parent} .= wrap(q|     |,q|     |,$_);
       }else{
       substr($compo{$parent},(-1 * (3 + $columns))
         ) =          wrap(q|     |,q|     |,$_);
       }
       $compo{$parent} .= $divdr;
       next;
   }
 # -------------------------------------------------------------------
+-

   if  ($processed =~ /Reading specs from/) {
       unshift @intro => $processed     ; next ;
   } elsif (/\Agcc version/) {
       unshift @intro => q(   ).$_      ; next ;
   }

   if    (/with:/)
   {
       $bctarget = substr($_, rindex ($_=>' '));
       substr($_, rindex ($_=>' ')) = '' if $bctarget !~ /--\S+/;
       push @bconfig => $_              ; next ;
   }
   elsif (/Thread model:/)  { next }

   push @goods => ($processed ? $processed : $_);
}
close ($fh); # Done reading in output.

# Post-process gcc & slaves output dumps.
unshift @goods => (   @intro
   , grep { $_ } map($compo{$_} , qw(CPP CC AS))   );
# We're ready to tell all:
printin (@goods, 2);
printin ($divdr
    , map( (/^(?:Configured|Thread)/? '':'  --').$_.qq{\n},
       map { split /\s+--/, $_ }@bconfig )
    , ($bctarget ? "target $bctarget" : "")
    ,    substr($divdr=>3), 2) if @bconfig;

exit 0;

sub printin
{
    my $indent_by = pop;
    $indent_by = ' ' x $indent_by;
    foreach my $line (@_)
    {
    my $in = $line !~ m%\A\s*\Z% ? $indent_by : "";
    printf STDOUT "$in%s" => $line;
    }
}

sub END
{ # Clean up after ourselves.
    unlink 'foo.c', 'foo.o';
}

__DATA__
Reading specs from D:\MinGW32\gcc-2.95.2\bin\..\lib\gcc-lib\i386-mingw
+32msvc\2.95.2\specs
gcc version 2.95.2 19991024 (release)
 D:\MinGW32\gcc-2.95.2\bin\..\lib\gcc-lib\i386-mingw32msvc\2.95.2\cpp.
+exe -lang-c -v -iprefix D:\MinGW32\gcc-2.95.2\bin\..\lib/gcc-lib/i386
+-mingw32msvc\2.95.2\ -D__GNUC__=2 -D__GNUC_MINOR__=95 -Di386 -D_WIN32
+ -DWIN32 -D__WIN32__ -D__MINGW32__=0.2 -D__MSVCRT__ -DWINNT -D_X86_=1
+ -D__STDC__=1 -D__stdcall=__attribute__((__stdcall__)) -D_stdcall=__a
+ttribute__((__stdcall__)) -D__cdecl=__attribute__((__cdecl__)) -D__de
+clspec(x)=__attribute__((x)) -D__i386__ -D_WIN32 -D__WIN32__ -D__WIN3
+2__ -D__MINGW32__=0.2 -D__MSVCRT__ -D__WINNT__ -D_X86_=1 -D__STDC__=1
+ -D__stdcall=__attribute__((__stdcall__)) -D___stdcall__=__attribute_
+_((__stdcall__)) -D__cdecl=__attribute__((__cdecl__)) -D__declspec(x)
+=__attribute__((x)) -D__i386 -D__WIN32 -D__WINNT -D___stdcall=__attri
+bute__((__stdcall__)) -Asystem(winnt) -Acpu(i386) -Amachine(i386) -re
+map -Acpu(i386) -Amachine(i386) -Di386 -D__i386 -D__i386__ foo.c G:\T
+MP\ccZhaaaa.i
GNU CPP version 2.95.2 19991024 (release) (80386, BSD syntax)
#include "..." search starts here:
#include <...> search starts here:
 D:\MinGW32\gcc-2.95.2\bin\..\lib\gcc-lib\i386-mingw32msvc\2.95.2\..\.
+.\..\..\include
 D:\MinGW32\gcc-2.95.2\bin\..\lib\gcc-lib\i386-mingw32msvc\2.95.2\..\.
+.\..\..\i386-mingw32msvc\include
 D:\MinGW32\gcc-2.95.2\bin\..\lib\gcc-lib\i386-mingw32msvc\2.95.2\incl
+ude
End of search list.
The following default directories have been omitted from the search pa
+th:
 /gcc-2.95.2/lib/gcc-lib/i386-mingw32msvc/2.95.2/../../../../include/g
+++-3
 /usr/local/i386-mingw32/include
End of omitted list.
 D:\MinGW32\gcc-2.95.2\bin\..\lib\gcc-lib\i386-mingw32msvc\2.95.2\cc1.
+exe G:\TMP\ccZhaaaa.i -quiet -dumpbase foo.c -version -o G:\TMP\ccOpa
+aaa.s
GNU C version 2.95.2 19991024 (release) (i386-mingw32msvc) compiled by
+ GNU C version 2.95.2 19991024 (release).
 as -o foo.o G:\TMP\ccOpaaaa.s
[download]

Hello Monks,

A handful of free services on the Net are offering free "online hard drives" (I will leave it as an exercise to the reader to check out the specifics of the offers each entity makes). To make a short list, there is:

• myspace.com (formerly freediskspace.com)
• driveway.com
• xdrive.com

As a user I find a lot to be annoyed about concerning all these sites -- but they are free, after all, so complaining about their buggy systems is pretty pointless. However as a coder I am not satisfied to leave it alone; I cannot help but wonder if there isn't a challenge to be met there. If their coders cannot get their sites to work, maybe I can overcome the obstainancy of their systems with some judiciously applied Perl?

Just for reference, because some readers may wonder what I mean by "buggy", I'll observe that file uploads often fail. It may be that some of these services (I have accounts with them all <sigh> ..) have file size limits that I forget in between each time I need to upload (and I'd like to arrange for someone reliable, like Perl, to remember that kind of thing for me ... wouldn't this be true laziness ?) Also the desktop client software for Win32 that can be downloaded for most of the services is not working on WinNT (even though it is supposed to -- a situation that many NT users must find quite tiresomely familiar; it is an industry-wide problem with mass-marketed commercial software).

My meditation concerns this: an invitation to

1. Let us know if anyone knows of existing Perl hacks into these systems, so that uploading or downloading of files from the remote storage server can be programmatically controlled;
2. Let us know if anyone has been thinking about this, but hasn't written any working code yet;
3. Let us (me specifically) know if the idea interests any fellow monks and they would like to collaborate on a project.

For my part I have little detailed knowledge of how these systems work, and don't want to assume without knowing more than I do, and I think that hacking this all by myself is a bit beyond my abilities at present. However I recently came across a clue that suggested to me that xdrive, for instance, is simply using a variety of FTP transaction (as might well all of them be) to upload to the remote server.

My guess is that this would be true "hacking" as the clueless mass media knows it, involving the running of a packet sniffer on one's system to monitor and suss out what is taking place between one's desktop / laptop box and the remote server, and then seeking to construct a workable emulation of that in Perl, adding all sorts of error-checking, redundancy and try-again-until-it-uploads obstinancy of course. I have never used a packet sniffer. A sockets guru might find this a worthy game?

I would welcome any replies, insights, or expressions of interest.

    soren

Please note that this looks all wrong to UNI* gurus who see the quoting through typical shell rules that apply there; Win is different and there's a couple of not-well-known Windoze shell escaping tricks demonstrated in this code, as well.

Also shows how to open a pipe to a process to be written to by Perl, has the ugly kludge of writing a tmp file -- if anyone knows a *Windoze*-workable way to avoid this please comment.

Snippet 1: format code

perl "-MHTML::FromText" "-MWin32::Clipboard" -e "$clp=Win32::Clipboard();$ct=$clp->Get(); $ct=text2html($ct,paras=>1,blockcode=>1,metachars=>1);$clp->Set($ct);"

Snippet 2: format ordinary comment or quoted text - step 1 -

perl "-MWin32::Clipboard" "-MText::Wrap=$columns,fill" -e "$clp=Win32::Clipboard();$ct=$clp->Get(); $columns=68;$ct=fill('','',$ct); $clp->Set($ct);"

Snippet 3: format ordinary comment text - step 2 -

perl "-MHTML::FromText" "-MWin32::Clipboard" -e "$clp=Win32::Clipboard();$ct=$clp->Get(); $ct=text2html($ct,paras=>1,blockquotes=>1,bold=>1,underline=>1,metachars=>1,urls=>1); $clp->Set($ct);"

Snippet 4: format quoted text - step 2 -

perl "-MHTML::FromText" "-MWin32::Clipboard" -e "$clp=Win32::Clipboard();$ct.=$clp->Get(); $ct=text2html($ct,lines=>1,spaces=>1,bold=>1,underline=>1,metachars=>1); $ct='<I><BLOCKQUOTE>'.$ct .'</I></BLOCKQUOTE>'; $clp->Set($ct);"

Snippet 5: deal with the square brackets - Perlmonks requires this extra step -

perl "-MWin32::Clipboard" -e "$clp=Win32::Clipboard();$s=$clp->Get();1 while( $s =~ s/ ([\[\]]) / sprintf \"&#%03u;\",ord $1 /exg);$clp->Set($s);"

To explain more clearly what I mean, I have created a little screenshot:
Each of these shortcuts has as its "Properties|Shortcut|Target" one of the perl one-liners shown here.
<IMG SRC="http://www.wonderstorm.com/cgi-bin/PNGem.pl?filtershortcuts" WIDTH=213 HEIGHT=153 HSPACE=16 VSPACE=10>

Message effectiveness can be said to eq substance + style. Poorly
formatted messages that require a lot of extra effort to read are
not as likely to be read as ones that are carefully presented.

Have to remark that there are those of us who love the command line
but don't plan on completely giving up our mouse and our GUI just
yet. The reason I make that statement has nothing to do with OSs or
inflamatory OT debates except to observe that more Windoze users
are (duh) more acclimated to doing things with the gui than at a
prompt. As I just said I am not interested in engaging in
judgemental debates about THAT, but i think there's a segment of
the monks out there (present or future) who would appreciate the
comfortable-ness of what I propose here, find it congenial, and
adjusted to their way of doing things. OTOH, Maybe i am wrong about
that but what does it matter.

So this snippet is about using a point-and-click means of rapidly
formatting text for entry into the kind of PerlMonks-site browser
entry field that I am using right now. It is Win32-specific. The
Windoze Explorer guishell allows one to right-click and create a
new shortcut. Normally a shortcut points to an existing file
somewhere on the filesystem, of course. The shortcut created in
order to use this Perl I am presenting isn't pointing to anything,
however (except the Perl interpreter). It is a one-liner IOW.
It is a form of the ordinary kind of copy-paste operation most
Monks perform (I assume) many times a day, but with the extra step
of double-clicking a (hopefully very easily accessible, keeping a
special Explorer window view open all the time on the Desktop is
one the points that make this a time-saver) "active" shortcut that
unleashes the power of Perl on the contents of the clipboard,
replacing what the user placed on it with same, but now in
HTML-ized form.

The code in the snippets goes in the field "shortcut" in the
Properties box of the "shortcut-filters" as I am calling these
little pieces of Perl code. In order to work the user must have the
module Win32::Clipboard (ppm to get it if you don't have it) and
uses HTML::FromText to do the magic.

Caution: Needless to say, these one-liners must be pasted into the
appropriate field as one-liners regardless of how they got
wrapped when displayed in the reader's browser rendering of this
Perl Monks node.