SVN: toys/rsget.pl: Get/MegaUpload RSGet/AutoUpdate.pm RSGet/HTTPRequest.pm RSGet/Tools.pm rsget.pl

[sparky]

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" );