Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
PerlMonks (Embed perl into your clipboard)

by antirice (Priest)
on Nov 01, 2007 at 14:58 UTC ( #648493=CUFP: print w/replies, xml ) Need Help??

Note: this script currently only works in Windows.

I still need to tidy this up a bit but I've found it to be extremely useful.

Basically with this you can create short programs (I call them macros) that you can either use temporarily or promote it to a permanent macro. To create a macro is fairly simple:

-- def_macro hello my $name = shift || "world"; print "Hello $name!";

If you copy and paste, it will tell you that macro hello has been created. Now if you copy and paste:

-- hello

When you paste it will print "Hello world!" Now let's make our macro able to process either from cl or input.

-- def_macro hello my @in = map { chomp;length($_) ? $_ :() } (@ARGV,<STDIN>); chomp(@in); @in = "world" unless @in; print "Hello $_" for @in;

Now this works:

-- hello me myself I

Which produces:

Hello me Hello myself Hello I

If we restart our script, we will lose our sweet -- hello macro (you can try this with -- restart 1). If you want this to become a permanent macro, we can promote it with -- promote_macro hello. Once we do that, it creates a standalone script that works as normal.

Script follows:

#!/usr/bin/perl -l # by antirice on perlmonks # This is released under the same terms as perl package TempOut; use overload '""' => 'as_string', fallback => 1; sub new { my $opt = shift; my $content = ''; open my $t, '>', \$content or die "Unable to open temp stdout: $!" +; my $orig = select $t; undef $\ if $opt; return bless [ $orig, \$content]; } sub DESTROY { my $self = shift; return unless $self->[0]; select $self->[0]; undef $self->[0]; $\ = $/; } *release = \&DESTROY; sub as_string { return ${shift->[1]}; } package TempIn; sub new { my (undef,$txt) = @_; open my $fh, "<&STDIN" or die "Unable to duplicate STDIN: $!"; close STDIN; open STDIN, "<", \$txt; return bless [ $fh ]; } sub DESTROY { my $self = shift; close STDIN; open STDIN, "<&", $self->[0] or die "Unable to restore STDIN: $!"; close $self->[0] } package main; use Win32::Clipboard; use IPC::Run 'run'; use File::Temp; use File::Spec::Functions 'rel2abs'; use Text::ParseWords 'shellwords'; use Data::Dumper; use B::Deparse; use strict; use vars '$c'; $/ = "\r\n"; my $v = shift; $v = $v && $v eq '-v' ? 1 : 0; $main::c = Win32::Clipboard->new(); my $last = ""; my $count = 0; my %macros; my %subs = ( reload => \&reload, list => \&list, def_macro => \&def_macro, rem_macro => \&rem_macro, exit => sub { $c->Set("Good bye ;-)");exit }, restart => \&restart, codefor => \&codefor, fullcodefor => \&fullcodefor, justrestart => sub { restart([1]) }, promote_macro => \&promote_macro ); my %commands; my %scripts; # find available commands in commands directory reload(); while ($c->WaitForChange) { next unless $c->IsText && $count++; my $t = $c->GetText or next; next if $t eq $last || $t !~ /^'?-+\s*([\w-]+)([ \t]+[^\r\n]+)?[\ +r\n]*(.*)$/s; $last = $t; my ($command,$params,$in) = ($1,$2,$3); # do this afterwards so we have our variables set before using the + regex engine again $command = lc $command; $params =~ s/^\s+//g; next unless exists $commands{$command}; if (ref $commands{$command}) { print "Executing macro $command"; eval { $commands{$command}->(parse($params),$in) }; print "Finished execution"; print $c->GetText if $v; next; } my $out; $c->Set('** EXECUTING **'); (my $stupid_win = $^X) =~ s/\\/\\\\/g; if ($v) { print qq{Executing: [$^X "$commands{$command}" $params]}; print "Parses as: ",Dumper(parse(qq["$stupid_win" "$commands{$ +command}" $params])); } eval { run(parse(qq["$stupid_win" "$commands{$command}" $params]), \$ +in, \$out); }; $out = "***** ERROR *****:\n$@" if $@; $out =~ s~(?<!\r)\n~$/~g; $c->Set($out); print $c->GetText if $v; $last = $out; } sub parse { my $line = shift ; $line =~ s{(\\[\w\s])}{\\$1}g ; return [ shellwords $line ]; } sub reload { undef %commands; for (<commands/*.pl>) { next unless -f; my ($check) = m!([\w-]+)\.pl$!g or next; $commands{lc $check} = rel2abs($_); $commands{lc $check} =~ s/\\/\\\\/g; } %scripts = %commands; %commands = (%commands,%subs,%macros); my $out = "Commands available: \r\n"; $out .= join "\r\n", map qq[ -- $_], sort keys %commands; print $out; $c->Set(($count ? "Reload successful!\r\n":'').$out); print Dumper(\%commands) if $v; } sub list { my $out = "Commands available: $/"; $out .= join $/, map qq[ -- $_], sort keys %commands; print $out; $c->Set($out); } sub def_macro { my ($args,$in) = @_; my ($name,$opt) = @$args; $c->Set("No body for the macro '$name' detected") unless $in; my $exec = eval { 'sub { my $temporary_out = TempOut->new("' . ($o +pt || '') . '"); my $temporary_in;local $_;local *ARGV;local $\\ = $/ +;local $/ = $/;local ${"} = ${"};local ${,} = ${,};{ my($XYZARGS,$INP +UT) = @_;*_ = $XYZARGS;@ARGV = @_;$temporary_in = TempIn->new($INPUT) + };' . $in . $/ . '; undef $temporary_in; $main::c->Set($temporary_ou +t->as_string); }' } or warn "Error! $@" and return; my $sub = eval { eval $exec or die $@ } or $c->Set("Error creating + macro '$name': $@") and print "Body: $/$exec" and return; $macros{lc $name} = $commands{lc $name} = $sub; local $, = $/; print "Built code as: ",B::Deparse->new->coderef2text($sub),"Macro + $name successfully created", if $v; $c->Set("Macro $name successfully created"); } sub rem_macro { my ($args,$in) = @_; my ($name) = @$args; $c->Set("Macro $name not found") and return unless exists $command +s{$name}; delete $commands{lc $name}; delete $macros{lc $name}; $c->Set("Macro $name successfully removed"); } sub restart { my $args = shift; $c->Set("You will lose all macros. Please pass 1 as the first para +meter if you wish to continue.") and return unless @$args && $args->[ +0] eq "1"; $c->Set("** RESTARTING **"); print "$/$/Please stay tuned for the following messages.$/$/****** + RESTARTING ******$/"; undef $c; exec("$^X $0"); } sub codefor { my $args = lc shift->[0]; my $out; if (exists $macros{$args} && ref $macros{$args}) { my @x = map { s/^ {4}//;$_ } split m!\n!,B::Deparse->new->code +ref2text($macros{$args}); $out = join($/, " -- def_macro $args", @x[16..($#x - 3)],"","# + End of macro"); } else { $out = "$args is not a macro" } $c->Set($out); } sub fullcodefor { my $args = lc shift->[0]; my $out; if (exists $macros{$args}) { $out = join $/, split m!\n!,B::Deparse->new->coderef2text($mac +ros{$args}); } else { $out = "$args is not a macro" } $c->Set($out); } sub promote_macro { my $args = lc shift->[0]; my $out; if (! exists $macros{$args}) { $out = "Macro $args doesn't exist"; } else { $out = eval { my @x = map { s/^ {4}//;chomp;$_ } split m!\n!,B::Deparse- +>new->coderef2text($macros{$args}); mkdir "commands" unless -d "commands"; open my $f, '>', rel2abs("commands/$") or die $@; print $f $_ for "#!/usr/bin/perl -l","",'# Macro promoted +' . localtime,'# shift defaults to @_ in subroutines so we ought to c +opy this over','@_ = @ARGV;','',@x[16..($#x - 3)]; close $f or die $@; delete $macros{$args}; $commands{$args} = $scripts{$args} = rel2abs("commands/$ar"); "Macro $args successfully promoted!"; } || "Error promoting macro $args: $@"; } $c->Set($out); } __END__

If you have any suggestions, please message me.

UPDATE: I forgot to give a macro that lets you just evaluate whatever you pass in:

-- def_macro eval eval join "",<>

You will probably want to promote that macro.

UPDATE 2: Someone asked me what scenarios I use this for. My answer is: nearly everything. I use it to grab stuff out of sourcesafe and svn, lookup stuff in help files, look on the internet for stuff for me (-- perlmonks is nice =P), keep track of my time, generate code, etc etc. This is perl in your clipboard! Use your imagination! =)

UPDATE 3: Refer to Update 5.

UPDATE 4: I fixed a problem that had been bugging me (macros did not override STDIN).

UPDATE 5: I'm getting asked this a lot so I'm adding it here. IPC::Run is difficult to install through cpan. You will need to add the Bribes de Perl repository to ppm. To add the repository, you will need to follow these instructions and search for IPC-Run. If you have never used ppm, please refer to this page.

Replies are listed 'Best First'.
Re: (Embed perl into your clipboard)
by hawtin (Prior) on Nov 02, 2007 at 08:55 UTC

    What a great idea, looks like a good addition for Windows. One minor point, in your final example I think you actually mean.

    -- def_macro eval print eval join "",<>

      The way I meant it to be used was something like this:

      -- eval print for 1..100;

      or suppose you have a list of items and wish to build a derived table (nice for seeing which of the values doesn't exist in another table)

      -- eval print join "$/UNION ALL$/", map "SELECT $_ as x", 1..100;

      The intent was to let you pass plain perl and do whatever you want.

Re: (Embed perl into your clipboard)
by bradenshep (Beadle) on Nov 02, 2007 at 15:34 UTC
    I like this very much! I would ask for one more feature, is this is possible. (I'm maybe 80% sure it is... this is Windows, though, so customizability is lower than I would like.)

    What I want is something similar to the -- eval macro, but somewhat different. I want to be able to copy any Perl code, press a key combination (Windows+P for Perl?) and have the pasted text become the output of the Perl code. This is because often I want to run Perl code I've spotted on the web, and can't insert one of the -- macro headers.

    My brain is racing ahead, coming up with so many use cases for this, both with my proposed enhancement and without. Here's a few with the existing version, for the doubters:
    • Easy sorting by arbitrary Perl-style sorting blocks
    • Applying a regex (m//, s///, tr/// the possibilities here are making me drool) to the text following.
    • Transformations with an arbitrary map, grep, reduce.
    • Web lookup (Google define, custom Mechanize scripts to collect some data off other sites)
    • eval the first line, followed by input to the evaled code.
    I'm generating ideas so fast I'm forgetting them. If you do any kind of text mangling on Windows, this is a godsend.
    If only I had a thousand more upvotes to give. You've made my month.

    Edit: I notice it's Windows-only, but with a Unix-style shebang. I assume you have it running under Cygwin? If I want it running at startup on ActiveState, should it work?

      All right:

      -- def_macro eval_inplace my $count = 0; $main::c->Set("In place evaluation started. If you wish to disable, pl +ease copy -- end"); while ($main::c->WaitForChange) { $count++ % 2 or next; my $t = $main::c->GetText or next; last if $t =~ /^-- END/i; my $to = TempOut->new(); eval { eval "\$\\=\$/;$t;1" or die $@;1 } or $main::c->Set("Error +executing perl: $@ ($t)") and next; $main::c->Set($to->as_string); $to->release; } print "Exited successfully, clipcommand returned to normal";

      This is definitely a hack and shows why I need to clean up some things. However, if you run the script, copy that macro and copy -- eval_inplace, the macro will see everything you copy as perl code to execute and will dutifully populate the clipboard with its output (or the error it generated). To stop it, copy -- end. Also, you can't promote this macro and expect it to work (like I said, hack =)).

      Update: I forgot this part. I have the *nix style shebang line out of habit. I personally use it with ActiveState build 822.

        Alright, I'll have to live without it for now (not being able to promote it kind of defeats the effect) and hope for an eventual new version.

        I looked into getting it going on AS 822, but couldn't find various packages it seems to need. I'm not familiar enough with AS to know if it will work. I guess I'll just try it and see what errors come back, if any.

        Again, many, many thanks for this.
Re: (Embed perl into your clipboard)
by Anonymous Monk on Nov 02, 2007 at 12:24 UTC
    Interesting, but how does this work? What is "--"? Why do you need B::Deparse? Some more examples, please!
    And this is win32 only, right?

      Actually, it reacts to commands that start with - or '-. The reason I use -- is because I normally use it with SQL Server to generate scripts. The reason for the '- is because I also use VB (yes, boo hiss =/). I work in a Microsoft-only shop and I find that the languages I need to use benefit greatly from code generation.

      The reason for B::Deparse is so the script can get the source for the anonymous subs that have been generated. If you wish to see the entire subroutine that is generated for a macro, use the fullcodefor macro. codefor reconstructs the macro as you gave it, although it does a bit of cleaning up which I like.

      As for another example, here's a simple note/recall pair of macros.

      -- def_macro note my $file = shift or die "Please indicate the note you wish to create/a +ppend to"; mkdir 'notes' unless -e 'notes'; open my $fh, ">>", "notes/$file" or die "Couldn't open note for write: + $!"; local $/; print $fh $_ while <>; close $fh or die "Trouble closing file: $!"; print "Successfully appended to note $file";

      -- def_macro recall my $file = shift or die "Please indicate the note you wish to open"; die "Note $file does not exist" unless -f "notes/$file"; open my $fh, "<", "notes/$file" or die "Couldn't open note for read: $ +!"; local ($/,$\); print <$fh>; close $fh or die "Couldn't close file: $!";

      To use:

      -- note example This should be the first line
      -- note example This should be the second line
      -- recall example


      This should be the first line This should be the second line

        I suspect some will find your example still quite unclear.

        The steps you left out boil down to something like:

        1. Get a computer running Win32.
        2. Run the script contained in the root node. Note that it will just hang out waiting.
        3. In whatever application you happen to be working in that allows you to type multiple lines of text, type in the text of the first example.
        4. Highlight the first example text that you just entered.
        5. "Cut" the example (probably by typing Ctrl-X).
        6. The script will quickly notice that something new has appeared in the cut/paste buffer (clipboard) and process it.
        7. Type, highlight, then "Cut" the second example.
        8. Type, highlight, then "Cut" (or "Copy") the third example.
        9. Wait just a little bit for the script to finish processing your third request.
        10. "Paste" (probably by typing Ctrl-V).
        11. Note that what gets pasted is the text after "Produces:"

        - tye        

Re: (Embed perl into your clipboard)
by antirice (Priest) on Nov 28, 2007 at 21:11 UTC
    I guess the only question I have is whether or not anyone (besides me) actually uses this.

      Just got it fully working. Can I ++vote for it again?

      Here's another simple example:

      --def_macro sort print sort <ARGV>; -- sort goibhniu BrowserUK Corion antirice BrowserUK Corion antirice goibhniu

      Which shows conclusively that antirice is greater than goibhniu, so:

      -- promote_macro sort Macro sort successfully promoted!

      I humbly seek wisdom.

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://648493]
Approved by Corion
Front-paged by kappa
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (5)
As of 2022-10-04 20:09 GMT
Find Nodes?
    Voting Booth?
    My preferred way to holiday/vacation is:

    Results (18 votes). Check out past polls.