/[Perly]/lib/Perly/Action/Run.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /lib/Perly/Action/Run.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 25 by dpavlin, Wed Jun 6 00:04:28 2007 UTC revision 26 by dpavlin, Wed Jun 6 10:52:54 2007 UTC
# Line 14  use Data::Dump qw/dump/; Line 14  use Data::Dump qw/dump/;
14  use File::Temp qw/tempdir/;  use File::Temp qw/tempdir/;
15  use File::Slurp;  use File::Slurp;
16  use Cwd qw/cwd/;  use Cwd qw/cwd/;
17    use Perly::Depends;
18    
19  use Jifty::Param::Schema;  use Jifty::Param::Schema;
20  use Jifty::Action schema {  use Jifty::Action schema {
# Line 72  sub take_action { Line 73  sub take_action {
73    
74          chdir( $dir ) || die "can't chdir $dir";          chdir( $dir ) || die "can't chdir $dir";
75    
76          write_file( $code->name, $code->source );          write_file( $code->name, $code->source ) or die "can't write " . $code->name . ": $!";
77          chmod 0700, $code->name;          chmod 0700, $code->name;
78          my $cmd = './' . $code->name;          my $cmd = './' . $code->name;
79          my $message = '$ <a href="/edit?id=' . $code->id . '">' . $code->name . '</a>';          my $message = '$ <a href="/edit?id=' . $code->id . '">' . $code->name . '</a>';
80    
81            my $deps = Perly::Depends->parse( $code->source );
82            foreach my $module ( @{ $deps->{depends_on} } ) {
83                    my $filename = $module . '.pm';
84                    my $dep_code = Perly::Model::Code->new;
85                    $dep_code->load_by_cols( name => $filename );
86                    die "can't find $filename -- do you need to create it first?\n" unless ( $dep_code->id );
87                    write_file( $filename, $dep_code->source ) or die "can't write $filename: $!";
88                    warn "dependency $module in file $filename\n";
89            }
90    
91          if ( $input->content ) {          if ( $input->content ) {
92                  write_file( $input->name, $input->content );                  write_file( $input->name, $input->content ) or die "can't write " . $input->name . ": $!";
93                  $cmd .= ' ' . $input->name;                  $cmd .= ' ' . $input->name;
94                  $message .= ' ' . $input->name;                  $message .= ' ' . $input->name;
95                  $self->result->content( input => $input->content );                  $self->result->content( input => $input->content );
96          }          }
97    
98          my $output = `$cmd 2>&1`;          my $output;
99            my $timeout = 5;
100    
101            eval {
102                    local $SIG{ALRM} = sub { die "Aborted execution after $timeout sec.\n" }; # NB: \n required
103                    alarm $timeout;
104                    $output = `$cmd 2>&1`;
105                    alarm 0;
106            };
107            if ($@) {
108                    die "$@\n" unless $@ eq "alarm\n";   # propagate unexpected errors
109            }
110    
111          $output =~ s/^Can't ignore signal CHLD, forcing to default\.\n//s;          $output =~ s/^Can't ignore signal CHLD, forcing to default\.\n//s;
112          $self->result->content( output => $output );          $self->result->content( output => $output );
113    
114          #warn "$message\n$output\n";          warn "$message\n$output\n";
115    
116          chdir( $cwd ) || die "can't return to $cwd";          chdir( $cwd ) || die "can't return to $cwd";
117    
Legend:
Removed from v.25  
changed lines
  Added in v.26
  ViewVC Help
Powered by ViewVC 1.1.26