Archive for the 'PERL' Category

16th Aug 2007

用 PERL 重写了 screen-wrapper

RT, 发现多个 session 时可以自己选择

#!/usr/bin/perl -w
#
# A wrapper for screen.
#

use strict ;

if (system("which screen > /dev/null") == 0) {
    # screen is found
    my $screen_command = `which screen` ;
    chomp $screen_command ;

    if ($#ARGV != -1) {
        exec "$screen_command" , @ARGV ;
    } else {
        my @sock_list = `$screen_command -ls` ;
        @sock_list = grep { s/^\s*// ; m/tached/ } @sock_list ;
        if ($#sock_list == -1) {
            exec "$screen_command"
        } elsif ($#sock_list == 0) {
            exec "$screen_command -x"
        } else {
            print "There are ",$#sock_list+1," screens. Please choose one to attache.\n\n";
            for(my $i=0; $i <= $#sock_list; $i++) {
                print " ",$i+1,"\t",$sock_list[$i];
            }
            print "\nPress ENTER to choose the first one for default.\n" ;
            print "Your choice: ";
            while (my $choice = <STDIN>) {
                chomp $choice;
                if ($choice eq '') {$choice = 1};
                if (($choice =~ m/\d+/) && ($choice >=1 ) && ($choice <= $#sock_list+1)) {
                    $sock_list[$choice-1] =~ m/^(\S+).*$/ ;
                    exec $screen_command." -x $1";
                } else {
                    print "Please choose from [1-",$#sock_list+1,"] : ";
                }
            }
        }
    }
}
else {
    print STDERR "Error: screen not found. Have you installed screen?\n" ;
    exit -1;
}

Posted by Posted by admin under Filed under Linux, PERL, Programming Comments No Comments »

01st Jul 2007

imageshack 上传脚本 ── 改进版

前几天介绍的 imageshack 上传脚本 有一个缺点, 就是 imageshack 会不时修改上传页面, 导致使用模拟方法的脚本失效. 而且每次都要先下载上传页面, 比较慢. 于是我就想到了将上传页面放在本地:

将 imgshack 脚本改成这样(感谢:老狼):

#!/usr/bin/perl -w
use strict;
use WWW::Mechanize;
use FindBin qw($Bin);

# suppress warnings about malformed forms
$SIG{__WARN__} = sub {} ;

my $url = "file://$Bin/imgshack_client.html";

my $mech = WWW::Mechanize->new();

foreach (@ARGV)
{
    $mech->get($url);

    $mech->form_number(1);
    $mech->field('fileupload' => $_);
    $mech->submit();

    # follow the link to see the image
    $mech->follow_link( text => 'Show', n => 1 );

    # display the URL of the uploaded image
    print (($mech->images())[0]->url() . "\n");
}

然后在脚本的相同目录下建一个网页文件 imgshack_client.html :

<html>
    <head></head>
    <body>
        <form action="http://load.imageshack.us/" method="post" enctype="multipart/form-data" target="_blank">
            <input name="fileupload" type="file">
            <input type="submit">
        </form>
    </body>
</html>

这样的话就不受远程上传页面的控制了

Posted by Posted by admin under Filed under Linux, PERL, Programming Comments No Comments »

30th Jun 2007

方便的 imageshack 上传脚本

自从有了 nopaste 脚本, 贴文字信息(特别是程序输出)就成了件很轻松的事 ── 只要灌到管道线就可以了. 但是贴图还是比较麻烦. 今日一番搜索, 找到了这个: http://www.terminally-incoherent.com/blog/2007/06/27/batch-upload-images-to-imageshack-using-perl/

#!/usr/bin/perl -w
use strict;
use WWW::Mechanize;
 
# suppress warnings about malformed forms
$SIG{__WARN__} = sub {} ;
 
my $url = "http://www.imageshack.us/";
 
my $mech = WWW::Mechanize->new();
 
foreach (@ARGV)
{
    $mech->get($url);
 
    $mech->form_number(2);
    $mech->field('fileupload' => $_);
    $mech->submit();
 
    # follow the link to see the image
    $mech->follow_link( text => 'Show', n => 1 );
    my @im = $mech->images();
 
    # display the URL of the uploaded image
    print $im[0]->url() . "\n";
}

将该网页所示的代码另存为一个脚本, 例如 imgshack , 别忘了加上x权限, 然后

imgshack imagefile_1 [ imagefile_2 ... ]

成功上传后会输出url, 很方便.

ps: 作者在使用过程中遇到一个问题. 注意脚本中

$mech->form_number(2);

这一句. imageshack 貌似会不时调整上传页面的表单元素顺序, 所以如果某天这个脚本灵了, 可以试试将2改成其它数字(1, 3, 4 … )

Posted by Posted by admin under Filed under Linux, PERL, Programming Comments No Comments »