Author: sparky
Date: Wed Sep 30 01:55:01 2009
New Revision: 10640
Modified:
toys/rsget.pl/Get/MegaUpload
toys/rsget.pl/RSGet/AutoUpdate.pm
toys/rsget.pl/RSGet/HTTPRequest.pm
toys/rsget.pl/RSGet/Tools.pm
toys/rsget.pl/rsget.pl
Log:
- support config file
- automatically download new getters from svn
Modified: toys/rsget.pl/Get/MegaUpload
==============================================================================
--- toys/rsget.pl/Get/MegaUpload (original)
+++ toys/rsget.pl/Get/MegaUpload Wed Sep 30 01:55:01 2009
@@ -11,8 +11,8 @@
pre:
use Image::Magick;
- my $mu_font_db = $main::data_path . "/data/mu_font_db.png";
- die "Font DB '$mu_font_db' does not exist\n" unless -r $mu_font_db;
+ my $mu_font_db = data_file( "mu_font_db.png" );
+ die "Font DB '$mu_font_db' does not exist\n" unless $mu_font_db;
start:
( my $uri = $-{_uri} ) =~
s#^(http://(?:www\.)?)(?:megarotic|sexuploader)#$1megaporn#;
Modified: toys/rsget.pl/RSGet/AutoUpdate.pm
==============================================================================
--- toys/rsget.pl/RSGet/AutoUpdate.pm (original)
+++ toys/rsget.pl/RSGet/AutoUpdate.pm Wed Sep 30 01:55:01 2009
@@ -3,13 +3,37 @@
use strict;
use warnings;
use RSGet::Tools;
+use Cwd;
set_rev qq$Id$;
sub update
{
- warn "Can't update yet\n";
- return 0;
+ unless ( require_prog( "svn" ) ) {
+ warn "SVN client required\n";
+ return 0;
+ }
+ my $start_dir = getcwd();
+ chdir $main::configdir or die "Can't chdir to '$main::configdir'\n";
+
+ warn "Updating from SVN\n";
+ my $updated = 0;
+ foreach my $dir ( qw(data RSGet Get Link) ) {
+ my $last;
+ open SVN, "-|", "svn", "co", "$settings{svn_uri}/$dir";
+ while ( <SVN> ) {
+ chomp;
+ $updated++ if /^.{4}\s+$dir/;
+ $last = $_;
+ }
+ close SVN;
+ unless ( $last =~ /Checked out revision \d+/ ) {
+ warn "Uppdate failed ?\n";
+ }
+ }
+ chdir $start_dir;
+
+ return $updated;
}
1;
Modified: toys/rsget.pl/RSGet/HTTPRequest.pm
==============================================================================
--- toys/rsget.pl/RSGet/HTTPRequest.pm (original)
+++ toys/rsget.pl/RSGet/HTTPRequest.pm Wed Sep 30 01:55:01 2009
@@ -52,7 +52,7 @@
$headers->{Content_Type} = sprintf "text/%s; charset=utf-8",
($1 eq "js" ? "javascript" : "css");
local $/ = undef;
- open F_IN, '<', $main::data_path . "/data/" . $file;
+ open F_IN, '<', data_file( $file );
$_ = <F_IN>;
close F_IN;
@@ -648,7 +648,7 @@
} else {
$ct = "image/png";
local $/ = undef;
- open F_IN, '<', $main::data_path . "/data/error.png";
+ open F_IN, '<', data_file( "error.png" );
$data = <F_IN>;
close F_IN;
}
Modified: toys/rsget.pl/RSGet/Tools.pm
==============================================================================
--- toys/rsget.pl/RSGet/Tools.pm (original)
+++ toys/rsget.pl/RSGet/Tools.pm Wed Sep 30 01:55:01 2009
@@ -7,7 +7,7 @@
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(set_rev s2string bignum de_ml hadd hprint p isotime require_prog
- dump_to_file randomize %getters %settings);
+ data_file dump_to_file randomize %getters %settings);
@EXPORT_OK = qw();
our %settings;
@@ -111,6 +111,16 @@
return undef;
}
+sub data_file
+{
+ my $file = shift;
+ my $f = "$main::configdir/data/$file";
+ return $f if -r $f;
+ $f = "$main::data_path/data/$file";
+ return $f if -r $f;
+ return undef;
+}
+
sub dump_to_file
{
my $data = shift;
Modified: toys/rsget.pl/rsget.pl
==============================================================================
--- toys/rsget.pl/rsget.pl (original)
+++ toys/rsget.pl/rsget.pl Wed Sep 30 01:55:01 2009
@@ -7,9 +7,18 @@
use warnings;
our $data_path;
+our $configdir;
BEGIN {
$data_path = $ENV{PWD};
unshift @INC, $data_path;
+
+ my $cd = "$ENV{HOME}/.rsget.pl";
+ if ( -r $cd and -d $cd ) {
+ $configdir = $cd;
+ unshift @INC, $configdir;
+ } else {
+ $configdir = $data_path;
+ }
}
use Time::HiRes;
@@ -30,6 +39,7 @@
%settings = (
auto_update => undef,
+ svn_uri => 'http://svn.pld-linux.org/svn/toys/rsget.pl',
backup => "copy,move",
backup_suf => undef,
logging => 0,
@@ -53,6 +63,20 @@
}
}
+if ( -r "$configdir/config" ) {
+ open F_IN, "<", "$configdir/config";
+ while ( <F_IN> ) {
+ next if /^\s*(?:#.*)?$/;
+ chomp;
+ if ( s/^\s*([a-z_]+)\s*=\s*// ) {
+ set( $1, $_ );
+ next;
+ }
+ warn "Incorrect config line: $_\n";
+ }
+ close F_IN;
+}
+
# read options
while ( my $arg = shift @ARGV ) {
if ( $arg eq '-h' ) {
@@ -77,7 +101,7 @@
if ( $settings{auto_update} ) {
if ( RSGet::AutoUpdate::update() ) {
warn "Update successfull, restarting\n";
- exec $0, @save_ARGV;
+ exec $0, @save_ARGV, "--auto_update", 0;
}
}
if ( keys %settings ) {
@@ -101,19 +125,24 @@
new RSGet::Line();
# add getters
-foreach my $type ( qw(Get Link) ) {
- foreach ( sort glob "$data_path/$type/*" ) {
+foreach my $path ( ( $configdir, $data_path ) ) {
+ foreach my $type ( qw(Get Link) ) {
+ foreach ( sort glob "$path/$type/*" ) {
next if /~$/;
next if m{/\.[^/]*$};
( my $file = $_ ) =~ s#.*/##;
+ next if exists $getters{ $type . "::" . $file };
my ( $pkg, $getter ) = RSGet::Processor::read_file( $type, $_ );
my $msg = "${type}/$file: failed";
if ( $pkg and $getter ) {
$getters{ $pkg } = $getter;
$msg = "$pkg: added\n";
+ new RSGet::Line( "INIT: ", $msg );
+ } else {
+ warn "$msg\n";
}
- new RSGet::Line( "INIT: ", $msg );
}
+ }
}
new RSGet::Line();
new RSGet::Line( "rsget.pl started successfully" );
_______________________________________________
pld-cvs-commit mailing list
pld-cvs-commit@lists.pld-linux.org
http://lists.pld-linux.org/mailman/listinfo/pld-cvs-commit
