Posted by root
Mon, 09 Jun 2008 08:09:00 GMT
#!/usr/bin/perl
use strict;
use warnings;
use WWW::Mechanize;
use LWP::Simple;
use Data::Dumper;
use Time::HiRes qw( usleep tv_interval gettimeofday );
$|++;
my $url = shift || die "no url given!\n";
my $ext = shift || 'mp3'; #die "no file extention given!\n";
my $mech = WWW::Mechanize->new(agent=>"Mozilla/5.0");
my $ua = LWP::UserAgent->new;
my %seen;
$mech->get($url);
$ua->timeout(5);
my $links = $mech->links;
no warnings;
my $c = 0;
for my $link ( @{$links} ) {
my $url = $link->url_abs;
my $res = $ua->head($url);
my $http_res = HTTP::Response->new($res);
my $abs_name = $http_res ->{'_rc'}->{'_previous'}->{'_headers'}->{'location'};
my ($rel_name) = $abs_name =~ /.+\/(.+)$/;
my $local_name = $rel_name;
$seen{$local_name}++ and next;
if( $rel_name =~ /\Q$ext\E$/i ){
$rel_name =~ s/\%\d+/ /g;
$rel_name =~ s/(.{35}).+/$1.../;
print(pack('A45', "[$rel_name]"), " is being downloaded ... ");
my $s_time = q{};
my $e_time = q{};
my $flag = [];
for( 1..5 ){
local $SIG{ALRM} = sub { die("timeout") };
eval {
alarm(10);
$flag = [head($abs_name)];
alarm(0);
};
next if $@ =~ m|timeout|;
last if $@ !~ m|timeout|;
}
if( $flag->[0] ){
$c++;
$s_time = [gettimeofday];
getstore($abs_name, $c."-".$local_name);
$e_time = tv_interval ($s_time, [gettimeofday]);
}
$e_time = $e_time ? $e_time . " seconds" : 'less than 1 milisecond';
print "timeout failure in $e_time seconds :(\n" and next if $@;
print "done in $e_time\n";
}
}
`ruby -e 'Dir["*"].each{|f| File.rename f, f.sub(/^\d+-/, "")}'`;
`ruby -e 'Dir["*"].each{|f| File.rename f, f.gsub(/%20/, "_")}'`;
Posted in Perl | Tags administration | no comments
Posted by root
Fri, 22 Feb 2008 21:23:00 GMT
use strict;
use warnings;
my $dom = shift || die "missing name\n";
my $res = qx{whois $dom};
die $1 . "for '$dom'\n" if $res =~ /(no\s+whois\s+server\s+)/i;
die "$dom is free\n" if $res =~ /no\s+match|does\s+not\s+exist/i;
die "$dom is reserved\n";
Posted in Perl, scripts | Tags money | no comments
Posted by root
Tue, 12 Feb 2008 20:12:00 GMT
Perl
$a = ("a", "b", "c"); # $a is "c" - the last element
($a) = ("a", "b", "c"); # $a is "a" - the first element
Ruby
obj = ["a", "b", "c"]
obj, b, c = ["a", "b", "c"]
Posted in programming, Ruby, Perl | no comments
Posted by root
Mon, 04 Feb 2008 21:57:00 GMT
#!/bin/bash
file=$1
if [ -e $file ]
then
vim $file
else
touch $file
echo '#!/usr/bin/perl' > $file
echo '' >> $file
echo 'use strict;' >> $file
echo 'use warnings;' >> $file
echo 'use diagnostics;' >> $file
echo '' >> $file
chmod +x $file
vim $file
fi
Posted in Perl, scripts | Tags UNIX | no comments
Posted by root
Sun, 03 Feb 2008 14:20:00 GMT
#!/usr/bin/perl
JAPH->Just->Another->Perl->Hacker;
package JAPH;
sub AUTOLOAD { bless [print+($AUTOLOAD=~/::(.+)/)[0], q/ /] } sub DESTROY {}
Posted in Perl | Tags japh | no comments
Posted by root
Sat, 02 Feb 2008 12:59:00 GMT
Perl script (thanks to the author of HTML::WikiConverter):
use strict;
use warnings;
use HTML::WikiConverter;
use Perl6::Slurp;
my $file_name = shift;
-f $file_name or die "No file given!\n";
my $wiki = new HTML::WikiConverter(dialect=>'MediaWiki');
print $wiki->html2wiki(slurp $file_name);
Posted in Perl, scripts | Tags converter, wiki | no comments
Posted by root
Sat, 19 Jan 2008 05:28:00 GMT
use strict;
use Getopt::Std;
use File::Basename;
getopts('scf:p:');
our($opt_s, $opt_c, $opt_f, $opt_p);
my $file = $opt_f;
my $size = $opt_p || 1;
my $len = 1024;
my $c = 1;
my ($buf, $counter);
-f $file or usage();
if($opt_s){
$size = 1024 * $size;
open IN, "< $file" or die "cannot open_r $file $!";
open OUT, "> $file.$c" or die "cannot open_w $file $!";
binmode IN;
binmode OUT;
while(read(IN, $buf, $len)){
$counter++;
if($counter > $size){
$counter = 0;
$c++;
close OUT;
open OUT, "> $file.$c" or die "cannot open_w $file $!";
binmode OUT;
}
print OUT $buf
}
} elsif($opt_c) {
my @files = grep { -f and /^$file\.\d+$/ } glob '*';
my $newfile = "splitter_$file";
open OUT, ">> $newfile" or die "cannot open_w $file $!";
binmode OUT;
map { $_ =~ s/^$file\.// } @files;
for(sort {$a<=>$b} @files ){
open IN, "$file.$_" or die "cannot open_r $file $!";
binmode IN;
print OUT $_ while <IN>;
close IN;
}
} else {
usage()
}
sub usage{
my $pro = basename($0);
print <<SQ;
$pro (-s|-c) -p piece size -f filename
-s split a file into pieces
-c collect a file from pieces
-p chunk size (defaults to 1MB)
-f file to be processed
SQ
exit 1
}
Posted in Perl, scripts | Tags splitter | no comments
Posted by root
Sat, 12 Jan 2008 08:57:00 GMT
Assume that we have directory, containing files like:
part_1.txt
part_2.txt
part_100.txt
part_200.txt
In case that we are interested in /(\d+)\.\w+$/ as part of the sorting criteria:
Perl
# short but unefficient
@a = sort {($a =~ /(\d+)\.\w+$/)[0] <=> ($b =~ /(\d+)\.\w+$/)[0]} <*>;
Ruby
regex = Regexp.new(/(\d+)\.\w+$/)
Dir["*"].grep(regex).sort do |a, b|
a.match(regex)[0].to_i <=> b.match(regex)[0].to_i
end
Dir["*"].grep(regex).sort_by do |name|
name.match(regex)[1].to_i
end
Posted in Ruby, Perl | Tags sorting | no comments
Posted by root
Fri, 11 Jan 2008 07:21:00 GMT
Perl
package MyClass;
package main;
*MyClass::from_my_class = sub {
print "defined in ", __PACKAGE__, "\n"
};
MyClass::from_my_class();
Ruby
class String
def self.from_string
print "defined in " + self.name + $/
end
end
String::from_string
String. from_string
Posted in Ruby, Perl | Tags methods, OOP | no comments
Posted by root
Wed, 09 Jan 2008 10:59:00 GMT
function manual:
search the text in perlfaq:
module content:
module absolute filename:
and of course:
Posted in Perl | Tags shortcuts | no comments