view release on metacpan or  search on metacpan

lib/Bio/Glite.pm  view on Meta::CPAN

#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
# This file is part of G-language Genome Analysis Environment package
#
#     Copyright (C) 2001-2009 Keio University
#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
# 
#   $Id: G.pm,v 1.4 2002/07/30 17:40:56 gaou Exp $
#
# G-language GAE is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
# 
# G-language GAE is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
# See the GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public
# License along with G-language GAE -- see the file COPYING.
# If not, write to the Free Software Foundation, Inc.,
# 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
# 
#END_HEADER
#
# written by Kazuharu Arakawa <gaou@sfc.keio.ac.jp> at
# G-language Project, Institute for Advanced Biosciences, Keio University.
#

package Bio::Glite;

use 5.008;
use strict;
use LWP::UserAgent;
use Data::Dumper;

require Exporter;

use base qw(Exporter);

our @EXPORT = qw(
COMGA_correlation COMGA_table_maker DoubleHelix Ew P2 RNAfold _blast _clustalw _codon_usage_table _fasta _formatdb aaui align_pathway alignment amino_counter amino_info annotate_with_glimmerM baseParingTest base_counter base_entropy base_individual_i...
	load
        say
        p
        puts
        readFile
        writeFile
);

our $VERSION = '0.10';

# Preloaded methods go here.

my $prefix  = 'http://rest.g-language.org/';
my $upload  = $prefix . 'upload/upl.pl';
my $ua = LWP::UserAgent->new;

sub load {
    my $this = {};

    $_[0] =  $ua->post($upload, 'Content_Type'=>'form-data', 'Content'=>['file'=>[$_[0]]])->content if(-e $_[0]);

    foreach my $line (split(/\n/, $ua->get($prefix . $_[0] . '/disclose')->content)){
	my ($feat, $key, $val) = split(/\t/, $line);
	if(length $val){
	    $this->{$feat}->{$key} = $val;
	}else{
	    $this->{$feat} = $key;
	}
    }

    foreach my $feat (keys %{$this}){
	next unless($feat =~ /FEATURE/);
        next unless ($this->{$feat}->{type} =~ /CDS|RNA/);
        
	$this->{$this->{$feat}->{gene}} = $this->{$feat} if(length $this->{$feat}->{gene});
	$this->{$this->{$feat}->{locus_tag}} = $this->{$feat} if(length $this->{$feat}->{locus_tag});
	$this->{'CDS' . $this->{$feat}->{cds}} = $this->{$feat} if($this->{$feat}->{type} eq 'CDS');
    }

    $this->{filename} = $_[0];
    print $ua->get($prefix . $_[0])->content;

    return bless $this;
}



sub AUTOLOAD{
    our $AUTOLOAD;
    my $gb = shift;
    my @args = @_;
    my @method = split(/::/, $AUTOLOAD);

    my $i = 0;
    my (@new_args);
    while(defined $args[$i]){
        if (substr($args[$i], 0, 1) eq '-' && substr($args[$i], 1, 1) !~ /[0-9]/){
            if(!defined($args[$i + 1]) || substr($args[$i + 1], 0, 1) eq '-' && substr($args[$i + 1], 1, 1) !~ /[0-9]/){
                push(@new_args, substr($args[$i], 1) . '=' . 1);
                $i ++;
            }else{
                push(@new_args, substr($args[$i], 1) . '=' . $args[$i + 1]);
                $i += 2;
            }
	}else{
	    push(@new_args, $args[$i]);
	    $i ++;
        }
    }

    my $url = $prefix . join('/', $gb->{filename}, $method[-1], @new_args);
    my $request = HTTP::Request->new('GET', $url);
    my $res = $ua->simple_request($request);
    my $result;

    if($res->is_redirect){
	$result = $res->header('Location');
    }else{
	if($res->is_success){
	    $result = $ua->get($url)->content;