Changeset 1513

Timestamp:

11/14/07 23:59:36 (6 years ago)

Author:

charsbar

Message:

lang/perl/Jipotter: added clear_sessions command, which would vacuum more than half of the jipotter db

Location:

lang/perl/Jipotter/trunk

Files:

• MANIFEST (modified) (1 diff)
• META.yml (modified) (1 diff)
• Makefile.PL (modified) (1 diff)
• etc/site_config.yml.sample (modified) (2 diffs)
• lib/Jipotter/Script.pm (modified) (1 diff)

lang/perl/Jipotter/trunk/MANIFEST

@@ -19 +19 @@
 lib/Jipotter/Script.pm
 lib/Jipotter/Script/Aggregate.pm
+lib/Jipotter/Script/ClearSessions.pm
 lib/Jipotter/Script/Schema.pm
 lib/Jipotter/Script/Server.pm

lang/perl/Jipotter/trunk/META.yml

@@ -25 +25 @@
   Jifty: 0.70824
   Jifty::DBI: 0.46
+  String::CamelCase: 0
   Template::Declare: 0.27
   Time::Piece: 0
+  Time::Seconds: 0
   URI: 0
   WWW::Shorten::TinyURL: 0

lang/perl/Jipotter/trunk/Makefile.PL

@@ -11 +11 @@
 requires    'DateTime::Format::Strptime';
 requires    'HTML::Entities';
+requires    'String::CamelCase';
 requires    'Time::Piece';
+requires    'Time::Seconds';
 requires    'WWW::Shorten::TinyURL';
 requires    'URI';

lang/perl/Jipotter/trunk/etc/site_config.yml.sample

@@ -2 +2 @@
   Plugins:
     - Jipotter::Plugin::Timelines:
-        items_per_page: 20
-
         Twitter:
           username: your_name
@@ -16 +14 @@
           username: your_name
           password: your_password
+
+  Session:
+    expire: 3
 
   Web: 

lang/perl/Jipotter/trunk/lib/Jipotter/Script.pm

@@ -4 +4 @@
 use warnings;
 use base qw( Jifty::Script );
+use String::CamelCase qw( camelize );
+
+sub get_cmd {
+    my ($class, $cmd, @arg) = @_;
+    die $class->error_cmd
+        unless $cmd && $cmd =~ m/^[?a-z_]+$/;
+    my $pkg = join('::', $class->command_class, $class->_cmd_map ($cmd));
+    my $file = "$pkg.pm";
+    $file =~ s!::!/!g;
+
+    unless (eval {require $file; 1} and $pkg->can('run')) {
+        warn $@ if $@ and exists $INC{$file};
+        die $class->error_cmd;
+    }
+    $cmd = $pkg->new (@arg);
+    $cmd->app ($class);
+    return $cmd;
+}
+
+sub _cmd_map {
+    my ($pkg, $cmd) = @_;
+    my %alias = $pkg->alias;
+    return $alias{$cmd} if exists $alias{$cmd};
+    return camelize($cmd);
+}
 
 1;