Changeset 21801

Timestamp:

10/21/08 22:48:38 (5 years ago)

Author:

ktat

Message:

make generated helper script including Helper::Simple.

Location:

lang/perl/Helper-Simple/trunk

Files:

• Makefile.PL (modified) (1 diff)
• lib/Helper/Simple.pm (modified) (7 diffs)

lang/perl/Helper-Simple/trunk/Makefile.PL

@@ -23 +23 @@
         'LWP::UserAgent'     => 0,
         'IO::String'         => 0,
-        'File::NCopy'        => 0,
         'Module::Pluggable'  => 0,
         'File::Where'        => 0,

lang/perl/Helper-Simple/trunk/lib/Helper/Simple.pm

@@ -13 +13 @@
 use Template ();
 use Tie::Hash::Indexed ();
-use Term::ProgressBar ();
 use Cwd qw/getcwd/;
 use LWP::UserAgent ();
 use IO::String ();
-use File::NCopy ();
 use Module::Pluggable ();
+use Clone ();
 use Config;
 
-use Clone ();
+eval "require Term::ProgressBar;";
+our $PROGRESSBAR = $@ ? 0 : 1;
 
 our @EXPORT_FUNCS = qw/file copy my_var dir_case subdir_case
@@ -75 +75 @@
       }
       foreach my $p (@pms) {
-        local $@;
         eval "require $p;";
         warn "require error: $p ($@)" if $@;
@@ -350 +349 @@
   local $Data::Dumper::Terse  = 1;
   $helper = $generator->($class, Dumper(\%DATA))  if defined $generator;
-
-  _write_file($helper_place, $helper ||= sprintf <<'__PL__', $Config{startperl}, ($class) x 4, Dumper(\%DATA));
+  $helper ||= sprintf <<'__PL__', $Config{startperl}, ($class) x 5, Dumper(\%DATA);
 #!%s
 
@@ -359 +357 @@
 no strict 'refs';
 
-use base 'Helper::Simple';
+push @%s::ISA, 'Helper::Simple';
 
 foreach my $pkg (grep /^%s::/, keys %%Helper::Simple::DATA) {
@@ -371 +369 @@
 }
 __PL__
+
+  local $/ = undef;
+  $helper .= "\n";
+  $helper .= slurp(File::Where->where_pm(__PACKAGE__));
+  _write_file($helper_place, $helper);
 }
 
@@ -629 +632 @@
 
   _info('download', $target);
-  my $progress = new Term::ProgressBar
-    ({
-      count => 512,
-      name  => "# downloading ",
-      ETA   => 'linear',
-     });
-  $progress->minor(0);           # turns off the floating asterisks.
-  $progress->max_update_rate(1); # only relevant when ETA is used.
-
-  my $did_set_target = 0;
-  my $received_size  = 0;
-  my $next_update    = 0;
-
-  my %args = (
-              ':content_cb' => sub {
-                my ($data, $cb_response, $protocol) = @_;
-                unless ($did_set_target) {
-                  if (my $content_length = $cb_response->content_length) {
-                    $progress->target($content_length);
-                    $did_set_target = 1;
-                  } else {
-                    $progress->target($received_size + 2 * length $data);
-                  }
-                }
-                $received_size += length $data;
-                $content .= $data;
-
-                $next_update = $progress->update($received_size) if
-                  $received_size >= $next_update;
-
-              },
-              ':read_size_hint' => 512,
-             );
+  my %args;
+  if ($PROGRESSBAR) {
+    my $progress = new Term::ProgressBar
+      ({
+        count => 512,
+        name  => "# downloading ",
+        ETA   => 'linear',
+       });
+    $progress->minor(0);           # turns off the floating asterisks.
+    $progress->max_update_rate(1);   # only relevant when ETA is used.
+
+    my $did_set_target = 0;
+    my $received_size  = 0;
+    my $next_update    = 0;
+
+    %args = (
+             ':content_cb' => sub {
+               my ($data, $cb_response, $protocol) = @_;
+               unless ($did_set_target) {
+                 if (my $content_length = $cb_response->content_length) {
+                   $progress->target($content_length);
+                   $did_set_target = 1;
+                 } else {
+                   $progress->target($received_size + 2 * length $data);
+                 }
+               }
+               $received_size += length $data;
+               $content .= $data;
+
+               $next_update = $progress->update($received_size) if
+                 $received_size >= $next_update;
+
+             },
+             ':read_size_hint' => 512,
+            );
+  }
   my $res = $ua->$req($target, $req eq 'get' ? (%{$option->{form} || {}}, %args)
                       : {%{$option->{form} || {}}, %args});
@@ -1006 +1012 @@
  here->dir; # returns "lib/Hoge/"
 
+=head1 TODO
+
+=over 4
+
+=item need helper program to create template.
+
+like the following;
+
+ helper-template -template catalyst YourApp
+ helper-setup -template catalyst YourApp ./yourapp.pl
+
+=back
+
 =head1 AUTHOR