7 use CXGN
::DB
::Connection
;
8 use CXGN
::TomatoGenome
::BACPublish qw
/tpf_agp_files/;
9 use CXGN
::Genomic
::Clone
;
10 use CXGN
::Genomic
::CloneIdentifiers qw
/parse_clone_ident/;
13 use CXGN
::Page
::FormattingHelpers
qw( info_section_html
20 use CXGN
::Publish qw
/publish/;
22 #tpf_agp is in the current directory
23 use CXGN
::TomatoGenome
::tpf_agp
qw(
24 format_validation_report
26 published_ftp_download_links
32 my $page = CXGN
::Page
->new("Tiling Path Display","Rob");
33 my $dbh = CXGN
::DB
::Connection
->new();
35 #get input arguments and validate
36 my ($chr) = $page->get_arguments(qw
/chr/);
37 $chr += 0; #force chr to be numeric
40 #if we have a file upload, validate it according to its type and store it
41 if(my $upload = $page->get_upload ) {
43 my $sp_person_id = CXGN
::Login
->new($dbh)->verify_session();
44 my $sp = CXGN
::People
::Person
->new($dbh, $sp_person_id);
46 or do {print $page->header; graceful_exit
("Username not found.")};
48 #check that the login has permission to upload for this chromosome
49 unless($sp->get_user_type eq 'curator'
50 || grep {$_ == $chr && $_ <= 12 && $_ >= 1} $sp->get_projects_associated_with_person) {
51 print $page->header(); graceful_exit
('your account does not have privileges to upload files for that chromosome');
54 my $validation_report = validate_and_publish_tpf
($upload->fh,$chr);
55 $page->message_page('TPF validation failed',$validation_report) if $validation_report;
59 $page->header('TPF Display',"Chromosome Tiling Paths");
61 <p>The tiling path listings below have been developed and submitted to
62 SGN by the individual <a href="/about/tomato_sequencing.pl">tomato
63 chromosome sequencing projects</a>.</p>
65 <p>The listing below shows the clones that make up the current planned
66 tiling path for this chromosome, along with any gaps that have yet
67 to be bridged by a sequence of clones.</p>
69 <p>It is in TPF format, which consists of three columns:</p>
71 <li>the NCBI/EMBL Accession of the BAC sequence</li>
72 <li>the SGN name of the BAC sequence</li>
73 <li>a name for each contiguous group of BACs, internal to each chromosome sequencing project</li>
76 <p>These files are also available for download <a href="ftp://ftp.sgn.cornell.edu/tomato_genome/tpf">via FTP</a>.</p>
79 if ($chr > 12 or $chr < 1){
80 graceful_exit
("Oops! Chromosome number must be between 1-12.");
83 print qq|<div style
="text-align: center; font-weight: bold; margin-bottom: 0.5em">Chromosome
</div
>\n|;
84 print modesel
( [map {["?chr=$_",$_]} 1..12], $chr-1);
88 #now show the current tpf and agp files
92 ($published_tpf,undef) = tpf_agp_files
($chr);
98 my ($published_tpf_ftp,undef) = published_ftp_download_links
($chr);
99 print info_section_html
( title
=> 'Tiling Path Format (TPF)',
100 subtitle
=> modtime_string
($published_tpf).' '.$published_tpf_ftp,
101 contents
=> tpf_to_html
($published_tpf) || <<EOHTML,
102 <center><b>No TPF file is currently available for chromosome $chr</b></center>
105 print info_section_html
( title
=> "Other Chromosome $chr Resources",
106 contents
=> <<EOHTML,
108 <li>Tomato maps: <a href="/cview/index.pl">Genetic</a> | <a href="/cview/map.pl?map_id=9&physical=1">Physical</a> | <a href="/cview/map.pl?map_id=13">BAC FISH results</a></li>
109 <li><a href="/tomato/genome_data.pl?chr=$chr">Chromosome $chr BACs in Genome Browser</a></li>
110 <li><a href="agp.pl?chr=$chr">Chromosome $chr Assembly (AGP)</a></li>
118 # we should NOT be using error_page! Use this instead!
129 #correct number of columns
130 #correct data type of each column
131 #correctly formed bac identifiers
132 #bac identifiers are on the correct chromosome
133 sub validate_and_publish_tpf
{
134 my ($tpf_fh,$chr) = @_;
135 my $publishing_filename = filename
($chr,'tpf');
136 my $tmp = File
::Temp
->new( UNLINK
=> 1, SUFFIX
=> '.tpf' );
140 push @errors, "Line $line_ctr: ".shift;
142 #copy the tpf file from the apache-spooled temp file. while doing
143 #that, go over each line and validate it
144 while(my $line = <$tpf_fh>) {
148 unless($line =~ /^\s*#/) {
149 my @d = split /\s+/,$line;
150 @d == 3 or $err->("Incorrect column count: ".scalar(@d)." columns found");
151 if( $d[0] =~ /^GAP$/ ) {
152 $d[1] =~ /^type-[1234]$|/ or $err->("If first column is GAP, second column must be a type-[1234] gap type");
153 $d[2] eq '?' or $err->("If first column is 'GAP', third column must be '?' (it is '$d[2]')");
155 elsif( $d[0] eq '?' || $d[0] =~ /^\S{5,}$/ ) {
156 my $p = parse_clone_ident
($d[1],qw
/agi_bac_with_chrom agi_bac/)
157 or $err->("If line is not a gap, second column must be a valid SGN BAC clone identifier");
159 my $c = CXGN
::Genomic
::Clone
->retrieve_from_parsed_name($p)
160 or $err->("Unknown clone identifier '$d[1]' in second column");
162 $c->chromosome_num == $chr
163 or $err->("BAC with identifier '$d[1]' is not registered as being on chromosome $chr");
164 $d[1] = $c->clone_name_with_chromosome;
169 $err->("Invalid first column '$d[0]'");
171 print $tmp join("\t",@d)."\n";
173 print $tmp "$line\n";
176 close $tmp; #make sure we flush the writes we made
178 return format_validation_report
(@errors);
180 publish
(['cp', "$tmp", $publishing_filename]);
187 if($filename && -f
$filename) {
188 return tabdelim_to_html
($filename,undef,
189 #this sub looks at the contents of each
190 #table cell and might emit some style rules
194 if ($contents =~ /^\s*#/) {
196 } elsif ( $contents =~ /^\s*GAP\s*$/ ) {
198 } elsif ( $contents =~ /^\s*\?\s*$/ ) {