[med-svn] r435 - in trunk/packages: . libbioperl-run-perl libbioperl-run-perl/branches libbioperl-run-perl/branches/upstream libbioperl-run-perl/branches/upstream/current libbioperl-run-perl/branches/upstream/current/Bio libbioperl-run-perl/branches/upstream/current/Bio/Installer

smoe-guest at alioth.debian.org smoe-guest at alioth.debian.org
Wed Sep 19 14:04:08 UTC 2007


Author: smoe-guest
Date: 2007-09-19 14:04:08 +0000 (Wed, 19 Sep 2007)
New Revision: 435

Added:
   trunk/packages/libbioperl-run-perl/
   trunk/packages/libbioperl-run-perl/branches/
   trunk/packages/libbioperl-run-perl/branches/upstream/
   trunk/packages/libbioperl-run-perl/branches/upstream/current/
   trunk/packages/libbioperl-run-perl/branches/upstream/current/Bio/
   trunk/packages/libbioperl-run-perl/branches/upstream/current/Bio/Installer/
   trunk/packages/libbioperl-run-perl/branches/upstream/current/Bio/Installer/Generic.pm
   trunk/packages/libbioperl-run-perl/tags/
Log:
[svn-inject] Installing original source of libbioperl-run-perl

Added: trunk/packages/libbioperl-run-perl/branches/upstream/current/Bio/Installer/Generic.pm
===================================================================
--- trunk/packages/libbioperl-run-perl/branches/upstream/current/Bio/Installer/Generic.pm	                        (rev 0)
+++ trunk/packages/libbioperl-run-perl/branches/upstream/current/Bio/Installer/Generic.pm	2007-09-19 14:04:08 UTC (rev 435)
@@ -0,0 +1,363 @@
+#!/usr/local/bin/perl
+
+# BioPerl module for Bio::Installer::Generic
+#
+# Cared for by Albert Vilella
+#
+# Copyright Albert Vilella
+#
+# You may distribute this module under the same terms as perl itself
+
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::Installer::Generic - DESCRIPTION of Object
+
+=head1 SYNOPSIS
+
+Give standard usage here
+
+=head1 DESCRIPTION
+
+Describe the object here
+
+=head1 FEEDBACK
+
+=head2 Mailing Lists
+
+User feedback is an integral part of the evolution of this and other
+Bioperl modules. Send your comments and suggestions preferably to
+the Bioperl mailing list.  Your participation is much appreciated.
+
+  bioperl-l at bioperl.org                  - General discussion
+  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
+
+=head2 Reporting Bugs
+
+Report bugs to the Bioperl bug tracking system to help us keep track
+of the bugs and their resolution. Bug reports can be submitted via
+the web:
+
+  http://bugzilla.open-bio.org/
+
+=head1 AUTHOR - Albert Vilella
+
+Email avilella-AT-gmail-DOT-com
+
+Describe contact details here
+
+=head1 CONTRIBUTORS
+
+Additional contributors names and emails here
+
+=head1 APPENDIX
+
+The rest of the documentation details each of the object methods.
+Internal methods are usually preceded with a _
+
+=cut
+
+
+# Let the code begin...
+
+
+package Bio::Installer::Generic;
+use vars qw(@ISA);
+use strict;
+
+# Object preamble - inherits from Bio::Root::Root
+
+use Bio::Root::Root;
+# Download file
+use LWP;
+use HTTP::Request::Common;
+
+ at ISA = qw(Bio::Root::Root );
+
+
+=head2 new
+
+ Title   : new
+ Usage   : my $obj = new Generic();
+ Function: Builds a new Generic object 
+ Returns : an instance of Generic
+ Args    : -origin_download_dir => from where is going to be downloaded
+           -destination_download_dir => where is going to be saved
+           -destination_install_dir => where is going to be installed
+           -package_name => name of the package to be downloaded
+           -directory_name => name of the directory once has been decompressed
+
+
+=cut
+
+sub new {
+    my($class, at args) = @_;
+
+    my $self = $class->SUPER::new(@args);
+
+    my ($origin_download_dir, 
+        $destination_download_dir, 
+        $destination_install_dir, 
+        $package_name, 
+        $directory_name) =
+            $self->_rearrange( [qw(ORIGIN_DOWNLOAD_DIR 
+                                   DESTINATION_DOWNLOAD_DIR 
+                                   DESTINATION_INSTALL_DIR 
+                                   PACKAGE_NAME 
+                                   DIRECTORY_NAME)],
+                               @args);
+    defined $origin_download_dir && $self->origin_download_dir($origin_download_dir);
+    defined $destination_download_dir && $self->destination_download_dir($destination_download_dir);
+    defined $destination_install_dir && $self->destination_install_dir($destination_install_dir);
+    defined $package_name && $self->package_name($package_name);
+    defined $directory_name && $self->directory_name($directory_name);
+
+    return $self;
+}
+
+
+=head2 origin_download_dir
+
+ Title   : origin_download_dir
+ Usage   : $obj->origin_download_dir($newval)
+ Function: 
+ Example : 
+ Returns : value of origin_download_dir (a scalar)
+ Args    : on set, new value (a scalar or undef, optional)
+
+
+=cut
+
+sub origin_download_dir{
+    my $self = shift;
+
+    return $self->{'origin_download_dir'} = shift if @_;
+    return $self->{'origin_download_dir'} || $self->get_default('ORIGIN_DOWNLOAD_DIR');
+}
+
+
+=head2 destination_download_dir
+
+ Title   : destination_download_dir
+ Usage   : $obj->destination_download_dir($newval)
+ Function: 
+ Example : 
+ Returns : value of destination_download_dir (a scalar)
+ Args    : on set, new value (a scalar or undef, optional)
+
+
+=cut
+
+sub destination_download_dir{
+    my $self = shift;
+
+    return $self->{'destination_download_dir'} = shift if @_;
+    return $self->{'destination_download_dir'} || $self->get_default('DESTINATION_DOWNLOAD_DIR');
+}
+
+
+=head2 destination_install_dir
+
+ Title   : destination_install_dir
+ Usage   : $obj->destination_install_dir($newval)
+ Function: 
+ Example : 
+ Returns : value of destination_install_dir (a scalar)
+ Args    : on set, new value (a scalar or undef, optional)
+
+
+=cut
+
+sub destination_install_dir{
+    my $self = shift;
+
+    return $self->{'destination_install_dir'} = shift if @_;
+    return $self->{'destination_install_dir'} || $self->get_default('DESTINATION_INSTALL_DIR');
+}
+
+
+=head2 package_name
+
+ Title   : package_name
+ Usage   : $obj->package_name($newval)
+ Function: 
+ Example : 
+ Returns : value of package_name (a scalar)
+ Args    : on set, new value (a scalar or undef, optional)
+
+
+=cut
+
+sub package_name{
+    my $self = shift;
+
+    return $self->{'package_name'} = shift if @_;
+    return $self->{'package_name'} || $self->get_default('PACKAGE_NAME');
+}
+
+
+=head2 directory_name
+
+ Title   : directory_name
+ Usage   : $obj->directory_name($newval)
+ Function: 
+ Example : 
+ Returns : value of directory_name (a scalar)
+ Args    : on set, new value (a scalar or undef, optional)
+
+
+=cut
+
+sub directory_name{
+    my $self = shift;
+
+    return $self->{'directory_name'} = shift if @_;
+    return $self->{'directory_name'} || $self->get_default('DIRECTORY_NAME');
+}
+
+
+=head2 env_name
+
+ Title   : env_name
+ Usage   :
+ Function:
+ Example :
+ Returns : 
+ Args    :
+
+
+=cut
+
+sub env_name{
+   my $self = shift;
+    return $self->{'env_name'} = shift if @_;
+    return $self->{'env_name'} || $self->get_default('ENV_NAME');
+}
+
+=head2 _remember_env
+
+ Title   : _remember_env
+ Usage   :
+ Function:
+ Example :
+ Returns : 
+ Args    :
+
+
+=cut
+
+sub _remember_env{
+   my ($self, at args) = @_;
+   my $dir;
+   $dir = $self->destination_install_dir;
+   $dir =~ s|/$||;
+   $dir .= "/" . $self->directory_name . "/" . $self->get_default('BIN_FOLDER');
+   my $env_name = $self->env_name;
+   print STDERR <<END;
+
+
+You will need to enable \$$env_name to help bioperl find the
+program. This can be done in (at least) two ways:
+ 1. define an environmental variable \$$env_name:
+	export $env_name=$dir
+    or
+ 2. include a definition of an environmental variable $env_name in
+     every script that will use the program in the corresponding
+     bioperl module.
+	BEGIN {\$ENV\{\'$env_name\'\}=$dir; }
+
+END
+  ;
+}
+
+
+=head2 _decompress
+
+ Title   : _decompress
+ Usage   :
+ Function:
+ Example :
+ Returns : 
+ Args    :
+
+
+=cut
+
+sub _decompress{
+   my ($self, at args) = @_;
+   my $call;
+   my $destination = $self->destination_download_dir . "/" . $self->package_name;;
+   my $destination_install_dir = $self->destination_install_dir;
+   if (($^O =~ /dec_osf|linux|unix|bsd|solaris|darwin/i)) {
+       $call = "tar xzvf $destination --directory=$destination_install_dir";
+       system("$call") == 0 or $self->throw("Error when trying to decompress package");
+       $call = "rm -f $destination";
+       system("$call") == 0 or $self->throw("Error when trying to delete compressed package");
+   } else {
+       $self->throw("_decompress not yet implemented in this platform");
+   }
+}
+
+
+=head2 download
+
+ Title   : download
+ Usage   : $installer->download();
+ Function:
+ Example :
+ Returns : 
+ Args    :
+
+
+=cut
+
+sub download{
+    my ($self, at args) = @_;
+    print "\n\nDownloading package...(this might take a while)\n\n";sleep 1;
+    my $file = $self->origin_download_dir;
+    $file =~ s|/$||;
+    $file .= "/" . $self->package_name;
+    my $destination = $self->destination_download_dir;
+    $destination =~ s|/$||;
+    $destination .= "/" . $self->package_name;;
+    my $ua = LWP::UserAgent->new;
+    my $response = $ua->request( GET($file), $destination );
+    die "Error at $file\n ", $response->status_line, "\n Aborting"
+        unless $response->is_success;
+    print "Package successfully downloaded at $destination.\n";
+
+    return $self;
+}
+
+
+=head2 uninstall
+
+ Title   : uninstall
+ Usage   : $installer->uninstall();
+ Function:
+ Example :
+ Returns : 
+ Args    :
+
+
+=cut
+
+sub uninstall{
+   my ($self, at args) = @_;
+   my $call;
+   my $destination = $self->destination_install_dir;
+   $destination =~ s|/$||;
+   $destination .= "/" . $self->directory_name;
+   print "\n\nUninstalling now: this will delete the installed program\n\n";
+   if (($^O =~ /dec_osf|linux|unix|bsd|solaris|darwin/i)) {
+       $call = "rm -rf $destination";
+       system("$call") == 0 or die "Error when trying to delete installed program $?\n";
+   } else {
+       $self->throw("uninstall not yet implemented in this platform");
+   }
+   return $self;
+}
+
+
+1;


Property changes on: trunk/packages/libbioperl-run-perl/branches/upstream/current/Bio/Installer/Generic.pm
___________________________________________________________________
Name: svn:executable
   + 




More information about the debian-med-commit mailing list