Changeset 26080 for lang/perl/Helper-Simple

Timestamp:

12/08/08 04:13:18 (4 years ago)

Author:

ktat

Message:

delete duplicated code; fix bug in extracting files

Location:

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

Files:

• Simple.pm (modified) (21 diffs)
• Simple/Const.pm (modified) (1 diff)

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

@@ -10 +10 @@
 use Archive::Zip qw/:ERROR_CODES/;
 use Data::Dumper;
-use IO::File ();
 use Template ();
 use Tie::Hash::Indexed ();
@@ -284 +283 @@
   my @path_exchange = @{$class->path_exchange};
   my $path_exchanger = @path_exchange ? sub {
-    my ($dir, $omit) = @_;
+    my ($dir) = @_;
     $$dir =~ s/^\Q$root_dir\E//;
     foreach my $ex (@path_exchange) {
@@ -309 +308 @@
 }
 
-sub setup_helper {
+sub setup_script {
   my ($class, $helper_place, $generator) = @_;
   my $helper;
@@ -363 +362 @@
       _ok(exists  => $dir . $file);
     } elsif (ref $c and my $compress = $c->{extract}) {
-      my $dir, $pkg->_extract($compress, $file, decode_base64($c->{content}), $path_exchanger, $c);
+      $pkg->_extract($compress, $file, decode_base64($c->{content}), $path_exchanger, $c);
       if (defined $c->{render_file} and $c->{render_file}) {
         $pkg->_render_file_recursive($c->{extract_to}, $path_exchanger);
@@ -551 +550 @@
     my $res = $pkg->_get_from_url($target, $option);
     if ($res->is_success and $content = $res->content) {
-      _info('download success', $target);
+      _ok('download', $target);
     } else {
-      _ng('download', $target);
+      if ($res->status_line eq '200 OK') {
+        _ng('download', $target . "(empty content)");
+      } else {
+        _ng('download', $target . "(" . $res->status_line . ")");
+      }
       $success = 0;
     }
     if ($success) {
       if (my $compress = $option->{extract}) {
-        $pkg->_extract($compress, $target, $content, undef, $option);
+        $pkg->_extract($compress, $target, $content, $path_exchanger, $option);
       } else {
         my $name = $option->{filename};
@@ -571 +574 @@
 sub _extract {
   my ($pkg, $compress, $target, $content, $path_exchanger, $option) = @_;
+  if ($compress eq 1) {
+    if ($target =~/\.(tar\.gz|tar\.bz2|zip|t[bg]z)$/) {
+      $compress = $1;
+    } else {
+      Carp::croak "cannot detect compress type from extention: $target";
+    }
+  }
   $compress =~ s/\./_/g;
   Carp::croak "cannot use $compress as compress option." unless $pkg->can("_extract_" . $compress);
 
   my $extract = '_extract_' . $compress;
-  if (my $dir = $pkg->$extract($target, $content, $path_exchanger, $option)) {
-    _ok('extracted to', $dir);
+  my $fh;
+  if ($content) {
+    $fh = IO::String->new(\$content);
+  } else {
+    $fh = IO::String->new(\do{slurp($target)});
+  }
+  if ($pkg->$extract($target, $fh, $path_exchanger, $option)) {
+    my $dir = $pkg->dir;
+    _ok('extracted to', $dir . ($option->{extract_to} || ''));
     if (defined $path_exchanger) {
       my $_dir = $dir;
       $path_exchanger->(\$_dir);
-      _info("path is exchanged", "$dir => $_dir");
-    }
-    return $dir;
+      _info("path is exchanged", "$dir => $_dir") if $dir ne $_dir;
+    }
+    return 1;
   } else {
     _ng('extract', $target);
@@ -616 +633 @@
 }
 
+sub _modify_filename {
+  my ($self, $filename, $option, $path_exchanger) = @_;
+  if (defined $option->{omit}) {
+    unless ($$filename =~s/^\Q$option->{omit}\E//) {
+      return 0;
+    }
+  }
+  $$filename = $self->dir
+    . ($option->{extract_to} ? $option->{extract_to} . '/': '') . $$filename;
+  if (defined $path_exchanger) {
+    $path_exchanger->($filename);
+  }
+  return 1;
+}
+
 sub _extract_zip {
-  my ($pkg, $target, $content, $path_exchanger, $option) = @_;
-  my $dir = $pkg->dir . ($option->{extract_to} ||= '');
-  $dir .= '/' unless $dir =~ m{/$};
-  my $fh;
-  if ($content) {
-    $fh = IO::String->new($content);
-  } else {
-    $fh = IO::File->new($target) or die "cannot open $target";
-  }
+  my ($pkg, $target, $fh, $path_exchanger, $option) = @_;
   my $zip = Archive::Zip->new();
   if ($zip->readFromFileHandle($fh) == AZ_OK) {
-    _info('extract', $target);
+    _info('extract', $pkg->dir . $target);
     foreach my $member ($zip->members) {
       my $filename = $member->fileName;
-      if (defined $option->{omit}) {
-        $filename =~s/^\Q$option->{omit}\E//;
-      }
-      $filename =  $dir . $filename;
-      if (defined $path_exchanger) {
-        $path_exchanger->(\$filename);
-      }
-      $zip->extractMember($member, $filename);
+      if ($pkg->_modify_filename(\$filename, $option, $path_exchanger)) {
+        $zip->extractMember($member, $filename);
+      }
       chmod $member->unixFileAttributes & ~ umask, $filename;
     }
-    return $dir;
+    return 1;
   } else {
     return 0;
@@ -651 +670 @@
 
 sub _extract_tar_gz {
-  my ($pkg, $target, $content, $path_exchanger, $option) = @_;
-  my $dir = $pkg->dir . ($option->{extract_to} ||= '');
-  $dir .= '/' unless $dir =~ m{/$};
-  my $fh;
-  if ($content) {
-    $fh = IO::String->new($content);
-  } else {
-    $fh = IO::File->new($target) or die "cannot open $target";
-  }
+  my ($pkg, $target, $fh, $path_exchanger, $option) = @_;
   $fh = IO::Uncompress::Gunzip->new($fh);
   my $tar = Archive::Tar->new();
@@ -666 +677 @@
     foreach my $file ($tar->list_files) {
       my $filename = $file;
-      if (defined $option->{omit}) {
-        $filename =~s/^\Q$option->{omit}\E//;
-      }
-      $filename =  $dir . $filename;
-      if (defined $path_exchanger) {
-        $path_exchanger->(\$filename);
-      }
-      $tar->extract_file($file, $filename);
-    }
-    return $dir;
+      if ($pkg->_modify_filename(\$filename, $option, $path_exchanger)) {
+        $tar->extract_file($file, $filename);
+      }
+    }
+    return 1;
   } else {
     return 0;
@@ -682 +688 @@
 
 sub _extract_tar_bz2 {
-  my ($pkg, $target, $content, $path_exchanger, $option) = @_;
-  my $dir = $pkg->dir . ($option->{extract_to} ||= '');
-  $dir .= '/' unless $dir =~ m{/$};
-  my $fh;
-  if ($content) {
-    $fh = IO::String->new($content);
-  } else {
-    $fh = IO::File->new($target) or die "cannot open $target";
-  }
+  my ($pkg, $target, $fh, $path_exchanger, $option) = @_;
   $fh = IO::Uncompress::Bunzip2->new($fh);
   if (my $tar = Archive::Tar->new($fh)) {
@@ -696 +694 @@
     foreach my $file ($tar->list_files) {
       my $filename = $file;
-      if (defined $option->{omit}) {
-        $filename =~s/^\Q$option->{omit}\E//;
-      }
-      $filename =  $dir . $filename;
-      if (defined $path_exchanger) {
-        $path_exchanger->(\$filename);
-      }
-      $tar->extract_file($file, $filename);
-    }
-    return $dir;
+      if ($pkg->_modify_filename(\$filename, $option, $path_exchanger)) {
+        $tar->extract_file($file, $filename);
+      }
+    }
+    return 1;
   } else {
     return 0;
@@ -787 +780 @@
 =head1 NAME
 
-Helper::Simple - simply create your own helper
+Helper::Simple - simply create your own setupper/helper
 
 =head1 VERSION
@@ -815 +808 @@
     use Helper::Simple;
     
-    YourApp::Helper->setup_helper('/path/to/yourhelper.pl');
+    YourApp::Helper->setup_script('/path/to/yourhelper.pl');
     
     1;
@@ -872 +865 @@
 This create files under ./path.
 
-=head2 setup_helper
-
- YourHelper->setup_helper('./path/to/helper.pl');
+=head2 setup_script
+
+ YourHelper->setup_script('./path/to/helper.pl');
 
 This create helper as ./path/to/helper.pl
 If you don't like default helepr script. you can set your own generator.
 
- YourHelper->setup_helper('./path/to/helper.pl', sub {
+ YourHelper->setup_script('./path/to/helper.pl', sub {
    my ($class, $data) = @_;
    # ....
@@ -941 +934 @@
 
 This copy file/directory from local.
-For $option, you can use C<extract>, c<omit> and C<render_file> of C<download>.
+
+For $option, see the follwoing.
+
+=head3 render_file => 0/1
+
+If you want to render extracted files, set this value true.
+default values is 0.
+
+=head3 extract => 'zip'/'tar.gz'/'tar.bz2' ...
+
+If $path_to_file is compressed file and you want to extract it,
+give the extention.
+
+ 1           ... judge from extention
+ zip         ... zipped file
+ tar.gz/tgz  ... tar gz
+ tar.bz2/tbz ... tar bzip2
 
 =head2 download / dl
@@ -950 +959 @@
 For $option, see the following.
 
-=head3 render => 0/1
-
-If you want to render extracted files, set this value true.
-default values is 0.
-
 =head3 extract => zip
 
@@ -960 +964 @@
 give the extention.
 
- zip ... zipped file
-
-In future, some formats will be added, gz, tar.gz, lzh etc.
+ 1           ... judge from extention
+ zip         ... zipped file
+ tar.gz/tgz  ... tar gz
+ tar.bz2/tbz ... tar bzip2
 
 =head3 omit => '/path/for/omit'
@@ -970 +975 @@
 give the directory name to omit.
 
+If you specify omit and path is not matched,
+such files are skipped to extract.
+
 =head3 filename => 'your_favolite_filename'
 
@@ -990 +998 @@
 =head2 var
 
-Set variables for Template module used in C<file>..
-This is inheritable vars. Namespaces under the namespace which this function is used,
-these
+Set variables for Template module used in C<file> or C<copy> with render_file option is true.
+This is inheritable vars. In the namespaces under the namespace which this function is used,
+defined vars can be used.
 
  var {
@@ -1001 +1009 @@
 =head2 my_var
 
-Set variables for Template module used in C<file>.
+Set variables for Template module used in C<file> or C<copy> with render_file option is true.
 This is like C<var>, but B<not> inheritable.
 
@@ -1023 +1031 @@
 =head2 here
 
+It is not recommended to use.
+
 From this function, you can use all method of Helper::Simple.
 It returns the called namespace object.
 
-It is not recommended to use.
-
  package YourHelper::Llib::Hoge;
  
  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 EXAMPLE
+
+It is very simple catalyst setupper.
+
+At first, create catalyst template.
+
+ % catalyst.pl CatalystTemplate
+ % cd ./CatalystTemplate
+ % ./script/catalysttempalte_create.pl View TT
+ % find -type f | xargs perl -p -i -e 's{CatalystTemplate}{\[% appclass %\]}g'
+ % find -type f | xargs perl -p -i -e 's{catalysttemplate}{\[% appname %\]}g'
+
+Next, create your catalyst setupper.
+
+ #!/usr/bin/perl
+ 
+ my $appclass = $ARGV[0];
+ my $appname  = lc $ARGV[0];
+ 
+ die "class name & helper name" unless $ARGV[1];
+ 
+ package MyHelper;
+ 
+ use strict;
+ use lib qw(../lib);
+ use Helper::Simple;
+ 
+ var {
+   appclass => $appclass,
+   appname  => $appname,
+ };
+ 
+ copy ['CatalystTemplate', {render_file => 1}];
+ 
+ package MyHelper::CatalystTemplate::root::static::js;
+ 
+ use Helper::Simple::Const;
+ 
+ copy ['jquery.ui-1.5.2.tar.bz2', {omit => 'jquery.ui-1.5.2', extract => 'tar.bz2'}];
+ dl JQUERY_SUGGEST;
+ 
+ package main;
+ 
+ MyHelper->path_exchange('CatalystTemplate/lib/CatalystTemplate', 'CatalystTemplate/lib/' . $appclass);
+ MyHelper->path_exchange('CatalystTemplate/script/catalysttemplate',  'CatalystTemplate/script/' . $appname );
+ MyHelper->path_exchange('CatalystTemplate/root/static/js/jquery.ui-1.5.2', 'CatalystTemplate/root/static/js/jquery.ui');
+ MyHelper->path_exchange('CatalystTemplate', $appclass);
+ MyHelper->setup_script($ARGV[1]);
+
 
 =head1 AUTHOR

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

@@ -2 +2 @@
 
 use constant {
-    JQUERY_UI                => ['http://jquery-ui.googlecode.com/files/jquery.ui-1.5.2.zip', {extract => 'zip'} ],
+    JQUERY_UI                => ['http://jquery-ui.googlecode.com/files/jquery.ui-1.5.2.zip', {extract => '1'} ],
     JQUERY_SUGGEST           => ['http://www.vulgarisoip.com/files/jquery.suggest.js'],
     JQUERY_MULTI_FILE_UPLOAD => ['http://www.fyneworks.com/jquery/multiple-file-upload/multiple-file-upload.zip' ],