view release on metacpan or  search on metacpan

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

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(<FILE>){
        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;
}