Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Comment on

( #3333=superdoc: 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 # clipcommand.pl 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/$args.pl") 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 +gs.pl"); "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.


In reply to clipcommand.pl (Embed perl into your clipboard) by antirice

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

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

    How do I use this? | Other CB clients
    Other Users?
    Others taking refuge in the Monastery: (5)
    As of 2014-07-13 04:03 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      When choosing user names for websites, I prefer to use:








      Results (245 votes), past polls