~ubuntu-branches/ubuntu/saucy/padre/saucy-proposed

« back to all changes in this revision

Viewing changes to lib/Padre/Util.pm

  • Committer: Package Import Robot
  • Author(s): Dominique Dumont, gregor herrmann, Dominique Dumont
  • Date: 2012-01-04 12:04:20 UTC
  • mfrom: (1.3.3)
  • Revision ID: package-import@ubuntu.com-20120104120420-i5oybqwf91m1d3il
Tags: 0.92.ds1-1
[ gregor herrmann ]
* Remove debian/source/local-options; abort-on-upstream-changes
  and unapply-patches are default in dpkg-source since 1.16.1.
* Swap order of alternative (build) dependencies after the perl
  5.14 transition.

[ Dominique Dumont ]
* Imported Upstream version 0.92.ds1
* removed fix-spelling patch (applied upstream)
* lintian-override: use wildcard to avoid listing a gazillion files
* updated size of some 'not-real-man-page' entries
* rules: remove dekstop cruft (replaced by a file provided in debian
  directory)
* control: removed Breaks statement. Add /me to uploaders. Updated
  dependencies
* rules: make sure that non-DFSG file (i.e. the cute butterfly, sigh)
  is not distributed

Show diffs side-by-side

added added

removed removed

Lines of Context:
31
31
use File::Spec      ();
32
32
use List::Util      ();
33
33
use Padre::Constant (); ### NO other Padre:: dependencies
 
34
### Seriously guys, I fscking mean it.
34
35
 
35
36
# If we make $VERSION an 'our' variable the parse_variable() function breaks
36
37
use vars qw{ $VERSION $COMPATIBLE };
37
38
 
38
39
BEGIN {
39
 
        $VERSION    = '0.90';
 
40
        $VERSION    = '0.92';
40
41
        $COMPATIBLE = '0.81';
41
42
}
42
43
 
57
58
#use constant MAC   => !!( $^O eq 'darwin' );
58
59
#use constant UNIX => !( WIN32 or MAC );
59
60
 
60
 
# Padre targets the three largest Wx backends
61
 
# 1. Win32 Native
62
 
# 2. Mac OS X Native
63
 
# 3. Unix GTK
64
 
# The following defined reusable constants for these platforms,
65
 
# suitable for use in Wx platform-specific adaptation code.
66
 
# Currently (and a bit naively) we align these to the platforms.
67
 
# NOTE: They're now in Padre::Constant, if you miss them, please use them from there
68
 
#use constant WXWIN32 => WIN32;
69
 
#use constant WXMAC   => MAC;
70
 
#use constant WXGTK   => UNIX;
71
 
 
72
61
# The local newline type
73
62
# NOTE: It's now in Padre::Constant, if you miss them, please use it from there
74
63
#use constant NEWLINE => Padre::Constant::WIN32 ? 'WIN' : Padre::Constant::MAC ? 'MAC' : 'UNIX';
477
466
}
478
467
 
479
468
sub splash {
480
 
        my $original = Padre::Util::sharefile('padre-splash-ccnc.bmp');
481
 
        return -f $original ? $original : Padre::Util::sharefile('padre-splash.bmp');
 
469
        my $original = Padre::Util::sharefile('padre-splash-ccnc.png');
 
470
        return -f $original ? $original : Padre::Util::sharefile('padre-splash.png');
482
471
}
483
472
 
484
473
sub find_perldiag_translations {
557
546
        return;
558
547
}
559
548
 
 
549
# Select and focus on the line within the editor provided
 
550
sub select_line_in_editor {
 
551
        my $line   = shift;
 
552
        my $editor = shift;
 
553
        $editor->EnsureVisible($line);
 
554
        $editor->goto_pos_centerize( $editor->GetLineIndentPosition($line) );
 
555
        $editor->SetFocus;
 
556
 
 
557
        return;
 
558
}
 
559
 
 
560
=pod
 
561
 
 
562
=head2 C<run_in_directory>
 
563
 
 
564
    Padre::Util::run_in_directory( $command, $directory );
 
565
 
 
566
Runs the provided C<command> in the C<directory>. On win32 platforms, executes
 
567
the command to provide *true* background process executions without window
 
568
popups on each execution. on non-win32 platforms, it runs a C<system>
 
569
command.
 
570
 
 
571
Returns 1 on success and 0 on failure.
 
572
=cut
 
573
sub run_in_directory {
 
574
        my ( $cmd, $directory ) = @_;
 
575
 
 
576
        # Make sure we execute from the correct directory
 
577
        if (Padre::Constant::WIN32) {
 
578
                require Padre::Util::Win32;
 
579
                my $retval = Padre::Util::Win32::ExecuteProcessAndWait(
 
580
                        directory  => $directory,
 
581
                        file       => 'cmd.exe',
 
582
                        parameters => "/C $cmd",
 
583
                );
 
584
                return $retval ? 1 : 0;
 
585
        } else {
 
586
                require File::pushd;
 
587
                my $pushd  = File::pushd::pushd($directory);
 
588
                my $retval = system $cmd;
 
589
                return ( $retval == 0 ) ? 1 : 0;
 
590
        }
 
591
}
 
592
 
 
593
=pod
 
594
 
 
595
=head2 C<run_in_directory_two>
 
596
 
 
597
Plugin replacment for perl command qx{...} to avoid black lines in non *inux os
 
598
 
 
599
        qx{...};
 
600
        run_in_directory_two('...');
 
601
 
 
602
optional parameters are dir and return type
 
603
 
 
604
        run_in_directory_two('...', $dir);
 
605
        run_in_directory_two('...', $dir, type);
 
606
 
 
607
also
 
608
 
 
609
        run_in_directory_two('...', type);
 
610
 
 
611
return type 1 default, returns a string
 
612
 
 
613
nb you might need to chomp result but thats for you.
 
614
 
 
615
return type 0 hash_ref
 
616
 
 
617
=over
 
618
 
 
619
=item example 1,
 
620
 
 
621
        Padre::Util::run_in_directory_two('svn --version --quiet');
 
622
 
 
623
        "1.6.12
 
624
        "
 
625
 
 
626
=item example 2,
 
627
 
 
628
        Padre::Util::run_in_directory_two('svn --version --quiet', 0);
 
629
 
 
630
        \ {
 
631
                error    "",
 
632
                input    "svn --version --quiet",
 
633
                output   "1.6.12
 
634
        "
 
635
        }
 
636
 
 
637
=back
 
638
 
 
639
=cut
 
640
 
 
641
#######
 
642
# function Padre::Util::run_in_directory_two
 
643
#######
 
644
sub run_in_directory_two {
 
645
        my $cmd_line = shift;
 
646
        my $location = shift;
 
647
        my $return_option = shift;
 
648
 
 
649
        if ( defined $location ) {
 
650
                if ( $location =~ /\d/ ) {
 
651
                        $return_option = $location;
 
652
                        $location = undef;
 
653
                }
 
654
 
 
655
        }
 
656
 
 
657
        my %ret_ioe;
 
658
        $ret_ioe{input} = $cmd_line;
 
659
 
 
660
        $cmd_line =~ m/((?:\w+)\s)/;
 
661
        my $cmd_app = $1;
 
662
 
 
663
        if ( defined $return_option ) {
 
664
                $return_option = ( $return_option =~ m/[0|1|2]/ ) ? $return_option : 1;
 
665
        } else {
 
666
                $return_option = 1;
 
667
        }
 
668
 
 
669
        # Create a temporary file for standard output redirection
 
670
        require File::Temp;
 
671
        my $std_out = File::Temp->new( UNLINK => 1 );
 
672
 
 
673
        # Create a temporary file for standard error redirection
 
674
        my $std_err = File::Temp->new( UNLINK => 1 );
 
675
 
 
676
        my $temp_dir = File::Temp->newdir();
 
677
 
 
678
        my $directory;
 
679
        if ( defined $location ) {
 
680
                $directory = ($location) ? $location : $temp_dir;
 
681
        } else {
 
682
                $directory = $temp_dir;
 
683
        }
 
684
 
 
685
        my @cmd = (
 
686
                $cmd_line,
 
687
                '1>' . $std_out->filename,
 
688
                '2>' . $std_err->filename,
 
689
        );
 
690
 
 
691
        # We need shell redirection (list context does not give that)
 
692
        # Run command in directory
 
693
        Padre::Util::run_in_directory( "@cmd", $directory );
 
694
 
 
695
 
 
696
        use File::Slurp;
 
697
        # Slurp command standard input and output
 
698
        $ret_ioe{output} = File::Slurp::read_file $std_out->filename;
 
699
        # chomp $ret_ioe{output};
 
700
 
 
701
        # Slurp command standard error
 
702
        $ret_ioe{error} = File::Slurp::read_file $std_err->filename;
 
703
        # chomp $ret_ioe{error};
 
704
        if ( $ret_ioe{error} && ( $return_option eq 1 ) ) {
 
705
                $return_option = 2;
 
706
        }
 
707
 
 
708
        return $ret_ioe{output} if ( $return_option eq 1 );
 
709
        return $ret_ioe{error} if ( $return_option eq 2 );
 
710
        return \%ret_ioe;
 
711
 
 
712
}
 
713
 
 
714
sub tidy_list {
 
715
        my $list = shift;
 
716
 
 
717
        require Padre::Wx;
 
718
        for ( 0 .. $list->GetColumnCount - 1 ) {
 
719
                $list->SetColumnWidth( $_, Wx::LIST_AUTOSIZE_USEHEADER() );
 
720
                my $header_width = $list->GetColumnWidth($_);
 
721
                $list->SetColumnWidth( $_, Wx::LIST_AUTOSIZE() );
 
722
                my $column_width = $list->GetColumnWidth($_);
 
723
                $list->SetColumnWidth( $_, ( $header_width >= $column_width ) ? $header_width : $column_width );
 
724
        }
 
725
 
 
726
        return;
 
727
}
 
728
 
560
729
1;
561
730
 
562
731
__END__