← Back to branch summary

~ubuntu-branches/ubuntu/utopic/circos/utopic

« back to all changes in this revision

Viewing changes to lib/Circos/Track.pm

  • Committer: Package Import Robot
  • Author(s): Olivier Sallou
  • Date: 2013-05-20 09:01:27 UTC
  • mfrom: (1.1.3)
  • Revision ID: package-import@ubuntu.com-20130520090127-s5nbumg8563x00ee
Tags: 0.64-1
New upstream release

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/Circos/Track.pm
65
65
our @type_ok = qw(scatter line histogram heatmap highlight tile text connector);
66
66
 
67
67
sub make_tracks {
68
 
    my ($conf_leaf,$track_default,$type) = @_;
69
 
    my @tracks;
70
 
    # If the tracks are stored as named blocks, associate the
71
 
    # name with the __id parameter for each track. Otherwise, generate __id
72
 
    # automatically using an index
73
 
    if(ref $conf_leaf eq "HASH") {
74
 
        # Could be one or more named blocks, or a single unnamed block.
75
 
        # If each value is a hash, then assume that we have named blocks
76
 
        my @values      = values %$conf_leaf;
77
 
        my $values_hash = grep(ref $_ eq "HASH", @values);
78
 
        if($values_hash == @values) {
 
68
        my ($conf_leaf,$track_default,$type) = @_;
 
69
        my @tracks;
 
70
        # If the tracks are stored as named blocks, associate the
 
71
        # name with the __id parameter for each track. Otherwise, generate __id
 
72
        # automatically using an index
 
73
        if (ref $conf_leaf eq "HASH") {
 
74
                # Could be one or more named blocks, or a single unnamed block.
 
75
                # If each value is a hash, then assume that we have named blocks
 
76
                my @values      = values %$conf_leaf;
 
77
                my $values_hash = grep(ref $_ eq "HASH", @values);
 
78
                if ($values_hash == @values) {
79
79
            # likely one or more named blocks
80
80
            printdebug_group("conf","found multiple named tracks");
81
81
            for my $track_name (keys %$conf_leaf) {
82
 
                printdebug_group("conf","adding named track [$track_name]");
83
 
                my $track      = $conf_leaf->{$track_name};
84
 
                if ( ref $track eq "ARRAY" ) {
85
 
                    fatal_error("track","duplicate_names",$track_name);
86
 
                }
87
 
                if(defined $track->{id}) {
88
 
                    $track->{__id} = $track->{id};
 
82
                                printdebug_group("conf","adding named track [$track_name]");
 
83
                                my $track      = $conf_leaf->{$track_name};
 
84
                                if ( ref $track eq "ARRAY" ) {
 
85
                                        fatal_error("track","duplicate_names",$track_name);
 
86
                                }
 
87
                                if (defined $track->{id}) {
 
88
                                        $track->{__id} = $track->{id};
 
89
                                } else {
 
90
                                        $track->{id}   = $track->{__id} = $track_name;
 
91
                                }
 
92
                                push @tracks, $track;
 
93
            }
89
94
                } else {
90
 
                    $track->{id}   = $track->{__id} = $track_name;
 
95
                        # likely a single unnamed block
 
96
                        printdebug_group("conf","found single unnamed track block");
 
97
                        push @tracks, $conf_leaf;
91
98
                }
92
 
                push @tracks, $track;
93
 
            }
94
 
        } else {
95
 
                # likely a single unnamed block
96
 
                printdebug_group("conf","found single unnamed track block");
97
 
                push @tracks, $conf_leaf;
98
 
            }
99
 
        } elsif(ref $conf_leaf eq "ARRAY") {
100
 
            # Multiple unnamed/named blocks. A named block will be a
101
 
            # hash with a single key whose value is a hash
102
 
            printdebug_group("conf","found multiple unnamed/named track blocks");
103
 
            for my $track (@$conf_leaf) {
104
 
                if(ref $track eq "HASH" && keys %$track == 1) {
 
99
        } elsif (ref $conf_leaf eq "ARRAY") {
 
100
                # Multiple unnamed/named blocks. A named block will be a
 
101
                # hash with a single key whose value is a hash
 
102
                printdebug_group("conf","found multiple unnamed/named track blocks");
 
103
                for my $track (@$conf_leaf) {
 
104
                        if (ref $track eq "HASH" && keys %$track == 1) {
105
105
                    # this could be a named track, or an unnamed track with
106
106
                    # a single entry
107
107
                    my ($track_name) = keys %$track;
108
 
                    if(ref $track->{$track_name} eq "HASH") {
109
 
                        $track = $track->{$track_name};
110
 
                        # it's named, because its entry is a hash
111
 
                            if(defined $track->{id}) {
112
 
                                $track->{__id} = $track->{id};
113
 
                        } else {
114
 
                            $track->{id}   = $track->{__id} = $track_name;
115
 
                        }
116
 
                        printdebug_group("conf","adding named track block [$track_name]");
117
 
                        push @tracks, $track;
 
108
                    if (ref $track->{$track_name} eq "HASH") {
 
109
                                        $track = $track->{$track_name};
 
110
                                        # it's named, because its entry is a hash
 
111
                            if (defined $track->{id}) {
 
112
                                                $track->{__id} = $track->{id};
 
113
                                        } else {
 
114
                                                $track->{id}   = $track->{__id} = $track_name;
 
115
                                        }
 
116
                                        printdebug_group("conf","adding named track block [$track_name]");
 
117
                                        push @tracks, $track;
118
118
                                } else {
119
 
                                    # it's unnamed
 
119
                                        # it's unnamed
120
120
                                        printdebug_group("conf","adding unnamed track block");
121
121
                                        push @tracks, $track;
122
122
                    }
123
 
                } else {
 
123
                        } else {
124
124
                    # unnamed
125
125
                    printdebug_group("conf","adding unnamed track block");
126
126
                    push @tracks, $track;
 
127
                        }
127
128
                }
128
 
            }
129
129
        }
130
130
        assign_auto_id(@tracks);
 
131
 
131
132
        # assign auto type
132
133
        for my $t (@tracks) {
133
 
            if(! defined $t->{type}) {
134
 
                $t->{type} ||= seek_parameter("type",$track_default);
135
 
                $t->{type} ||= $type;
136
 
                if(! defined $t->{type}) {
137
 
                    fatal_error("track","no_type",join(",",get_track_types()),$t->{id},Dumper($t));
138
 
                }
139
 
            }
140
 
            if(! defined $t->{file}) {
141
 
                fatal_error("track","no_file",$t->{type},$t->{id},Dumper($t));
142
 
            }
 
134
                if (! defined $t->{type}) {
 
135
                        $t->{type} ||= seek_parameter("type",$track_default);
 
136
                        $t->{type} ||= $type;
 
137
                        if (! defined $t->{type}) {
 
138
                                fatal_error("track","no_type",join(",",get_track_types()),$t->{id},Dumper($t));
 
139
                        }
 
140
                }
 
141
                $t->{file} ||= seek_parameter("file",$track_default);
 
142
                if (! defined $t->{file}) {
 
143
                        fatal_error("track","no_file",$t->{type},$t->{id},Dumper($t));
 
144
                }
143
145
        }
144
146
        assign_defaults(\@tracks,$track_default);
145
 
        clear_undef(\@tracks);
 
147
        #clear_undef(\@tracks);
146
148
        return @tracks;
 
149
 
147
150
}
148
151
 
149
152
sub clear_undef {
150
 
    my $tracks = shift;
151
 
    for my $t (@$tracks) {
152
 
        for my $param (keys %$t) {
 
153
        my $tracks = shift;
 
154
        for my $t (@$tracks) {
 
155
                for my $param (keys %$t) {
153
156
            delete $t->{$param} if $t->{$param} eq "undef";
 
157
                }
154
158
        }
155
 
    }
156
159
}
157
160
 
158
161
sub assign_defaults {