view release on metacpan or  search on metacpan

lib/App/Tk/Deparse.pm  view on Meta::CPAN

package App::Tk::Deparse;
use strict;
use warnings;
use 5.008;

use Browser::Open qw(open_browser open_browser_cmd);
use Path::Tiny qw(path);
use Capture::Tiny qw(capture);

use Tk;
use Tk::Dialog;
use Tk::HyperText;
use Tk::BrowseEntry;

our $VERSION = '0.02';

# TODO: make fonts more readable
# TODO: Clear the output when we change the input (or maybe rerun the deparse process?)
# TODO: use nice temporary filename as we can see the name of the file with the -l flags
# TODO: Save window size upon exit; restore window size upon start
# TODO: If there is a syntax error in the code B::Deparse will fail. We sould display this.


my $sample = q{
# Paste your code in the top window and click the Deparse button to see what B::Deparse thinks about it
for (my $j=0, $j<3, ++$j) {
    print $j;
}

my $pi = 3.14;      # -d changes this to a string
my $answer = "42";  # single quote or no quote?

my @planets = ('Mercury', 'Venus', 'Earth', 'Mars', 'Jupiter', 'Saturn');

my %h = (
name => "Foo Bar",
age => 42,
fruits => qw(Apple Banana Peach),
);


my $gentlemen = "Some names";
my $me = 'Perl';

print "Hello, $pi, @ladies, \u$gentlemen\E, \u\L$me!";

# Trying to show -P without success
sub foo (\@) { 1 } foo @x
};

my $s = q{
};

# Removed l for now showing the temporary filename does not do much good.
my @flags = ('d', 'p', 'q', 'P');

sub new {
    my ($class) = @_;
    my $self = bless {}, $class;

    $self->{top} = MainWindow->new(
        -title => 'B::Deparse',
    );
    $self->create_menu;
    $self->create_app;
    $self->{incode}->insert("0.0", $sample);
    $self->deparse;

    return $self;
}

sub create_menu {
    my ($self) = @_;

    my $main_menu = $self->{top}->Menu();

    my $file_menu = $main_menu->cascade(-label => 'File', -underline => 0);

lib/App/Tk/Deparse.pm  view on Meta::CPAN

<li>Frank Kropp</li>
<li>John Andersen</li>
<li>Magnus Enger</li>
<li><a href="https://www.linkedin.com/in/mjgardner/">Mark Gardner</a></li>
<li>Markus Hechenberger</li>
<li>Matthew Mitchell</li>
<li>Matthew Persico</li>
<li>Meir Guttman</li>
<li>Mike Small</li>
<li><a href="https://www.linkedin.com/in/n8dgr8/">Nathan Schlehlein</a></li>
<li><a href="https://www.linkedin.com/in/pfmabry/">Paul Mabry</a></li>
<li><a href="https://perl.careers/">Perl Careers</a></li>
<li>Richard Leach</li>
<li>Robert Coursen</li>
<li><a href="https://www.linkedin.com/in/shajiindia/">Shaji Kalidasan</a></li>
<li><a href="https://www.linkedin.com/in/shanta-mcbain-7b644437/">Shanta McBain</a></li>
<li><a href="https://www.linkedin.com/in/slobodanmiskovic/">Slobodan Mišković</a></li>
<li><a href="https://www.linkedin.com/in/stephen-jarjoura-a684401/">Stephen A. Jarjoura</a></li>
<li>Tony Edwardson</li>
<li><a href="https://www.linkedin.com/in/tori-hunter-00009639/">Tori Hunter</a></li>
<li><a href="https://bruck.co.il/">Uri Bruck</a></li>
<li>Victor Moral</li>
<li>Wolfgang Odendahl</li>
<li>Yes2Crypto</li>
<li>... + many others</li>
</ul>

      </body>
      </html>
    });

    $dialog->Show;
}

sub onResource {
    my ($html, %info) = @_;
    my $url = $info{href};
    #print $url, "\n";
    #open_browser($url); # https://rt.cpan.org/Public/Bug/Display.html?id=133315
    #print "done\n";
    my $cmd = open_browser_cmd($url);
    # TODO: verify that the URL is well formatted before passing it to system
    if ($^O eq 'MSWin32') {
        system("$cmd $url");
    } else {
        system("$cmd $url &");
    }
}

sub changed {
    my ($self, $event) = @_;
    # TODO can we delay this and only run the deparse process if there were no changes for some time (e.g. 1 sec)
    $self->deparse;
    #print("changed\n");
}

sub create_app {
    my ($self) = @_;
    $self->{incode} = $self->{top}->Text(
        -state => 'normal',
        -font  => ['fixed', 12],
        -bg    => 'white',
    );
    $self->{incode}->bindtags([$self->{incode}, 'Tk::Text', $self->{top}, 'all']);
    #$self->{incode}->bind('<<Modified>>' => sub { I could not get this working
    $self->{incode}->bind('<Any-KeyPress>' => sub { $self->changed(shift); });
    $self->{incode}->pack(-fill => 'both', -expand => 1);

    $self->{flags} = $self->{top}->Frame();
    $self->{flags}->pack(-side => 'top');

    for my $flag (@flags) {
        $self->{"${flag}_flag"} = 0;

        $self->{"${flag}_flag_checkbox"} = $self->{flags}->Checkbutton(
        -text     => "-$flag",
        -variable => \$self->{"${flag}_flag"},
        -font     => ['fixed', 10],
        -command  => sub { $self->deparse },
        );
        $self->{"${flag}_flag_checkbox"}->pack(-side => 'left');
    }
    # $self->{"s_flag"} = '';
    # my @s_values = qw(C i T);
    # $self->{"s_flag_widget"} = $self->{flags}->BrowseEntry(
    #     -label => "-s",
    #     -width => 3,
    #     -variable => \$self->{"s_flag"},
    # );
    # for my $s (@s_values) {
    #     $self->{"s_flag_widget"}->insert("end", $s);
    # }
    # $self->{"s_flag_widget"}->pack;

    $self->{outcode} = $self->{top}->Text(
        -state => 'disabled',
        -font => ['fixed', 12],
    );
    $self->{outcode}->pack(-fill => 'both', -expand => 1);


    $self->{deparse} = $self->{top}->Button(
        -text    => 'Deparse',
        -command => sub { $self->deparse },
    );
    $self->{deparse}->pack()

}

sub deparse {
    my ($self) = @_;

    my $code = $self->{incode}->get("0.0", 'end');
    my $temp = Path::Tiny->tempfile;
    path($temp)->spew($code);
        
    my $cmd = 'perl -MO=Deparse';
    for my $flag (@flags) {
        if ($self->{"${flag}_flag"}) {
            $cmd .= ",-$flag";
        }
    }
    if ($self->{s_flag}) {
        $cmd .= ",-s$self->{s_flag}"
    }

    my ($stdout, $stderr, $exit) = capture { system("$cmd $temp"); };
    $self->{outcode}->configure('state' => 'normal');
    $self->{outcode}->delete("0.0", 'end');
    if ($exit) {
        $self->{outcode}->configure('fg' => 'red');
        $self->{outcode}->insert("0.0", $stderr);
    } else {
        $self->{outcode}->configure('fg' => 'black');
        $self->{outcode}->insert("0.0", $stdout);
    }
    $self->{outcode}->configure('state' => 'disabled');
}

sub run {
    my ($self) = @_;
    MainLoop;
}

sub exit_app {
    my ($self) = @_;

    # TODO: Save flags when exiting
    # TODO: Save content of the input window when exiting
    # TODO: Save current window size so we can start the same size next time.
    # my %config = (
    #     'geometry' => $self->{top}->geometry,
    # );
    # path($config_file)->spew(encode_json(\%config));

    exit;
}