求助perl脚本，取某一段

huang6894

回复 9# pitonas


    跪求大神show show完整的程序。。。我看完您老那个帖，一直没安装成ImageMagick

pitonas

那 linux distribution?

回复 11# huang6894


   

pitonas

{:2_172:} 赞一个！
好厉害的小伙伴们, 这个必须赞一个



回复 10# huang6894


   

huang6894

回复 12# pitonas


    windows

huang6894

回复 13# pitonas


    哥。。。这是您上次教我的程序。。。。

pitonas

{:2_172:} How to Take a Screenshot in Microsoft Windows
http://www.wikihow.com/Take-a-Screenshot-in-Microsoft-Windows

回复 15# huang6894


   

huang6894

回复 16# pitonas


    赞~

stanley_tam

这回详细多了，下面是脚本代码，假设文件24.txt和你的序列文件在一个folder下面。
建议跑之前先进行备份，这个会改变原有的文件。。。

1. #!perl
   
2. use Modern::Perl;
   
3. use autodie;
   
4. use Tie::File;
   
5. 
   
6. # file store data to be extracted
   
7. my $data_reference = '24.txt';
   
8. my $fh;open $fh, '<', $data_reference;
   
9. 
   
10. while (defined(my $line = readline $fh)) {
    
11.     # remove trailing newline
    
12.     chomp $line;
    
13.     # remove heading and trailing spaces
    
14.     $line =~ s{^\s+ | \s+$}{}mgx;
    
15. 
    
16.     # split the line by spaces
    
17.     my ($file_name, $start_pos, $end_pos) = split /\s+/, $line;
    
18.     my @seq_lines = ();
    
19. 
    
20.     # map file to array
    
21.     tie @seq_lines, 'Tie::File', $file_name or
    
22.         die "Fail to tie file $file_name: !\n";
    
23. 
    
24.     for my $seq_line (@seq_lines){
    
25.         # skip line begin with >, no clue what it is about ...
    
26.         next if $seq_line =~ m{^>}m;
    
27. 
    
28.         # skip blank line
    
29.         next if $seq_line =~ m{^ \s* $}mx;
    
30. 
    
31.         # here comes the long sequence line
    
32.         my @pieces = split //, $seq_line;
    
33. 
    
34.         # get the pieces we want, convet position to index
    
35.         # this is in place change
    
36.         $seq_line = join '', @pieces[$start_pos-1 .. $end_pos-1];
    
37.     }
    
38. 
    
39.     # commit changes
    
40.     untie @seq_lines;
    
41. }
    
42. 
    
43. close $fh;
    
44. 
    
45. say "Done ! Press <ENTER> to exit.";
    
46. <STDIN>;
    
47. 
    
48. __END__

复制代码

回复 6# yang7473453


   

rubyish

try:

1. #!/usr/bin/perl
   
2. use strict;
   
3. use warnings;
   
4. 
   
5. my $list   = '/tmp/old/abc.txt';    # 表格
   
6. my $dir    = '/tmp/old';            # 有很多这样的文件
   
7. my $newdir = '/tmp/new';            # create a new dir
   
8. open my $L, '<', $list or die "$list\t$!";
   
9. my %H;
   
10. 
    
11. while (<$L>) {
    
12.     my ( $name, $pos, $end ) = split;
    
13.     $H{$name}{pos} = $pos;
    
14.     $H{$name}{len} = $end - $pos + 1;
    
15. }
    
16. 
    
17. for my $name ( keys %H ) {
    
18.     open my $old, '<', "$dir/$name"    or die "$dir-$name\t$!";
    
19.     open my $new, '>', "$newdir/$name" or die "$newdir-$name\t$!";
    
20.     print "$name$/";
    
21. 
    
22.     while (<$old>) {
    
23.         print $new $_ and next if /^>/;
    
24.         chomp;
    
25.         print $new substr( $_, $H{$name}{pos}, $H{$name}{len} ) . $/;
    
26.     }
    
27.     close $old;
    
28.     close $new;
    
29. }
    
30. 
    
31. print "$/finish$/";
    
32. 
    
33. __DATA__
    

复制代码

huang6894

@stanley_tam@rubyish两位大神真心名不虚传啊！！！学习了