File Coverage

blib/lib/Bio/Glite.pm

Criterion	Covered	Total	%
statement	15	82	18.2
branch	0	34	0.0
condition	0	16	0.0
subroutine	5	13	38.4
pod	1	6	16.6
total	21	151	13.9

#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
# 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  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_information_matrix base_information_content base_relative_entropy base_z_value blastall bui cai calc_pI cbi circular_map codon_compiler codon_counter codon_mva codon_usage cognitor complement consensus_z cor cumulative diffseq dinuc dist_in_cc dnawalk dote enc filter_cds_by_atg find_dif find_dnaAbox find_iteron find_king_of_gene find_ori_ter find_pattern find_tandem find_ter fop foreach_RNAfold foreach_tandem gcsi gcskew gcwin generateGMap genes_from_ori genome_map genome_map2 genome_map3 genomicskew gopac gpac grapher graphical_LTR_search icdi leading_strand least_squares_fit load load_kegg_api longest_ORF ma_filter ma_normalize ma_rfilter markov max maxdex mean median min mindex molecular_weight nucleotide_periodicity oligomer_counter oligomer_search oligomer_translation over_lapping_finder palindrome peptide_mass phx plasmid_map query_arm query_strand read_goa rep_ori_ter run_glimmerM seq2png seqinfo seqret set_essentiality set_gc3 set_goa set_gpac set_operon set_strand shuffleseq signature splitprintseq standard_deviation sum test_gpac to_fasta togoWS translate ttest variance view_cds w_value ws
	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;
	}else{
	    if($res->status_line =~ /404/){
		die("no such function $method[-1]");
	    }else{
		die($res->status_line);
	    }
	}
    }

    if($result =~ /\n +/ || $result =~ /http/){
	print $result, "\n";
    }else{
	return split(/\n/, $result);
    }
}

sub DESTROY{}

sub p{ print Dumper(@_), "\n"; }
sub puts{ print @_, "\n"; }
sub say{ print join(',', @_), "\n"; }

sub readFile{
    my $file = shift;
    my $chomp = shift || 0;
    my @result;

    open(FILE, $file) || die($!);
    while(){
        chomp if($chomp);
        push(@result, $_);
    }
    close(FILE);

    if(wantarray()){
        return @result;
    }else{
        return join('', @result);
    }
}


sub writeFile{
    my $data = shift;
    my $file = shift || "out.txt";

    open(OUT, '>' . $file) || die($!);
    print OUT $data;
    close(OUT);

    return $file;
}



1;

__END__