use NetCDF;

#========================================================
# constructors

sub nc_dim_new
{
    my ($name,$size)=@_;
    return {
	    'name' => $name,
	    'size' => $size,
	   };
}

sub nc_var_new
{
    my ($name, $type, $dims, $atts) = @_;
    
    my ($v, @vdims,@sizes,@start,@count);

    @vdims = @$dims;
    @sizes = map {$_->{'size'}} @vdims;
    @start = map {0} @vdims;
    @count = map {1} @vdims;
    $count[$#vdims] = $sizes[$#vdims];

    return {
 	    'name' => $name,
 	    'type' => $type,
 	    'dims' => [@vdims],
 	    'atts' => [@$atts],
 	    'io' => {
 		     'sizes' => [@sizes],
 		     'start' => [@start],
 		     'count' => [@count],
 		     'start_scalar' => 0,
 		     'count_scalar' => $sizes[$#vdims],
 		     'eof' => 0
 		    },
 	    };
}

sub nc_att_new
{
    my ($name, $type, $values) = @_;
    return {
	    'name' => $name,
	    'type' => $type,
	    'values' => [@$values]
           };
}

#========================================================

sub string_to_chars
{
    my $string = shift;
    return [ map{ord} split(//,$string."\0") ]; # (add NUL explicitly)
}

sub chars_to_string
{
    my $valsr = shift;
    my @vals = @$valsr;
    pop @vals if $vals[$#vals] == 0; # omit final nul
    return join('',map{chr}@vals);
}

#========================================================
#
#  nc_read(filename) 
#     Reads the header information from a NetCDF file and returns a
#     reference.  NB does not close the file, but leaves open so that 
#     variable contents can be read later.  Close with nc_close.
#

sub nc_read
{
    my $filename = shift;

    my ($s, $ncid, $unlimid,
        $dimid, @dims, $nd, $d, $dname, $dsize, $dunlim,
        $varid, @vars, $nv, $v, $vname, $vtype, $vnd, $vna, @vdimids, @vdims,
        @vatts,
        $na, @atts,
        $nc,
        @sizes,@start,@count);

    $ncid = NetCDF::open($filename,NetCDF::NOWRITE);
    
    $s = NetCDF::inquire($ncid, $nd, $nv, $na, $unlimid);

    @dims = ();
    for $dimid (0..$nd-1) {
        $s = NetCDF::diminq($ncid,$dimid,$dname,$dsize);
	$d = nc_dim_new($dname,$dsize);
        push(@dims,$d);
    }

    @vars=();
    for $varid (0..$nv-1) {
        $s = NetCDF::varinq($ncid,$varid,$vname,$vtype,$vnd,\@vdimids,$vna);
        
        @vdimids = @vdimids[0..$vnd-1];        
        @vdims = map {$dims[$_]} @vdimids;
        @vatts = map {nc_att_read($ncid,$varid,$_)} 0..$vna-1;

	$v = nc_var_new($vname,$vtype,\@vdims,\@vatts);
	nc_var_setsource($v,'file',$ncid,$varid);
        push (@vars,$v);
    }

    @atts = map {nc_att_read($ncid,NetCDF::GLOBAL,$_)} 0..$na-1;

    $dunlim = ($unlimid >= 0) ? $dims[$unlimid] : 0;

    $nc = {
           'name' => $filename,
           'id' => $ncid,
           'dims' => [@dims],
           'vars' => [@vars],
           'atts' => [@atts],
           'unlim' => $dunlim
           };

    return $nc;
}


sub nc_att_read
# helper routine for nc_read
{
    my ($ncid,$varid,$attid) = @_;

    my ($s, $aname, $atype, $alen, $a);

    my @avalue=();

    $s = NetCDF::attname($ncid,$varid,$attid,$aname);
    $s = NetCDF::attinq($ncid,$varid,$aname,$atype,$alen);
    $s = NetCDF::attget($ncid,$varid,$aname,\@avalue);

    $a = nc_att_new($aname,$atype,\@avalue);

    return $a;
}

#========================================================
#
# nc_write(filename, nc)
#
# nc is netcdf contents in the form returned by nc_read
#
sub nc_write
{
    my ($filename, $nc) = @_;

    my ($ncid,$s,
	$d,$dimid,$dsize,
	$v,@vdimids,$varid);

    #$ncid = NetCDF::create($filename,NetCDF::NOCLOBBER);
    $ncid = NetCDF::create($filename,0);
    
    $dimid=0;

    for $d(@{$nc->{'dims'}}) {
        $dsize = $d->{'size'};
        $dsize = NetCDF::UNLIMITED if $d == $nc->{'unlim'};
        $s = NetCDF::dimdef($ncid, $d->{'name'},$dsize);

        $d->{'out_dimid'} = $dimid;
        $dimid++;
    }
    
    $varid=0;
    for $v(@{$nc->{'vars'}}) {
	@vdimids = map {$_->{'out_dimid'}} @{$v->{'dims'}};
        $s = NetCDF::vardef($ncid,$v->{'name'},$v->{'type'},\@vdimids );
	    
	for $a(@{$v->{'atts'}}) {
	    nc_att_write($ncid,$varid,$a);
	}

	$v->{'io'}->{'out_varid'}=$varid;
	$varid++;
    }
    for $a(@{$nc->{'atts'}}) {
	nc_att_write($ncid,NetCDF::GLOBAL,$a);
    }

    $s=NetCDF::endef($ncid);

    for $v(@{$nc->{'vars'}}) {
	$varid=$v->{'io'}->{'out_varid'};

	nc_var_rewind($v);
	while (!nc_var_eof($v)) {
	    nc_var_xferslab($v, $ncid, $varid);
	}
    }

    $s=NetCDF::close($ncid);
}

sub nc_att_write
# helper routine for nc_write
{
    my ($ncid,$varid,$a) = @_;
    my $s;
    $s=NetCDF::attput($ncid,$varid,
		      $a->{'name'},$a->{'type'},$a->{'values'});
}

#========================================================
#
# nc_close closes file opened with nc_read
#
sub nc_close
{    
    my $nc = shift;

    my $s;
    $s = NetCDF::close($nc->{'id'});
}

#========================================================
#
# nc_show does something like an "ncdump"
#
sub nc_show
{
    my ($nc, $hdronly) = @_;
    my ($d,$v,$a, $vals);

    print "File: $nc->{'name'}\n";
    print "Dimensions:\n";
    for $d(@{$nc->{'dims'}}) {
        print "\t$d->{'name'} = $d->{'size'}";
        print " (UNLIM)" if $d == $nc->{'unlim'};
        print "\n";
    }
    print "Variables:\n";
    for $v(@{$nc->{'vars'}}) {
        print
            "\t",nc_typename($v->{'type'})," $v->{'name'}(",
            join(",", map{$_->{'name'}} @{$v->{'dims'}}),
            ")\n";

        for $a(@{$v->{'atts'}}) {
            print "\t\t",nc_att_show($a),"\n";
        }
    }
    print "Attributes:\n";
    for $a(@{$nc->{'atts'}}) {
        print "\t\t",nc_att_show($a),"\n";
    }
    if (!$hdronly) {
	print "Data:\n";
	for $v(@{$nc->{'vars'}}) {
	    print " $v->{'name'}:\n";
	    nc_var_rewind($v);
	    while (!nc_var_eof($v)) {
		$vals=nc_var_xferslab($v);
		print "   ",nc_data_show($v->{'type'},$vals),"\n";
	    }
	}
    }
}

sub nc_att_show
# helper routine for nc_show
{
    my $a=shift;
    return 
        nc_typename($a->{'type'}).' '.
        $a->{'name'}.' = '.
        nc_data_show($a->{'type'},$a->{'values'});
    
}

sub nc_typename
# helper routine for nc_show
{
    my $type=shift;
    my %typenames=(
                 NetCDF::BYTE => "byte",
                 NetCDF::CHAR => "char",
                 NetCDF::SHORT => "short",
                 NetCDF::LONG => "long",
                 NetCDF::FLOAT => "float",
                 NetCDF::DOUBLE => "double"
                   );
    return $typenames{$type};
}

sub nc_data_show
# helper routine for nc_show
{
    my ($type,$values) = @_;

    if ($type == NetCDF::CHAR) {
          return '"'.chars_to_string($values).'"';
    } else {
        my $format;
        if ($type == NetCDF::BYTE) {$format = "%d"}
        elsif ($type == NetCDF::SHORT) {$format = "%d"}
        elsif ($type == NetCDF::LONG) {$format = "%d"}
        elsif ($type == NetCDF::FLOAT) {$format = "%g"}
        elsif ($type == NetCDF::DOUBLE) {$format = "%g"}
        else {$format=""}
        return join(' ',map{sprintf($format,$_)}@$values);
    }
}
#========================================================
# Routines returning dims, vars, atts list
# (trivial, but keeps messy dereferencing expressions out of main program)
sub nc_dims
{
    my $nc = shift;
    return @{$nc->{'dims'}};
}
sub nc_vars
{
    my $nc = shift;
    return @{$nc->{'vars'}};
}
sub nc_atts
{
    my $v = shift;
    return @{$v->{'atts'}};
}


#========================================================
# Routines for finding dims, vars, atts by name
#
sub nc_find_dim
{
    my ($nc,$name)=@_;
    return find_by_name($nc->{'dims'},$name);
}
sub nc_find_var
{
    my ($nc,$name)=@_;
    return find_by_name($nc->{'vars'},$name);
}
sub nc_find_att
{
    my ($var,$name)=@_;
    return find_by_name($var->{'atts'},$name);
}

sub find_by_name
# helper routine for nc_find_*
{
    my ($lr,$name)=@_;
    my $hr;
    for $hr (@$lr){
	return $hr if $hr->{'name'} eq $name;	
    }
    return undef;
}
#========================================================
# Routines for finding indices of dims, vars, atts by name
# (the array index will equal the ID if written to a NetCDF file)
#
sub nc_find_dim_index
{
    my ($nc,$name)=@_;
    return find_index_by_name($nc->{'dims'},$name);
}
sub nc_find_var_index
{
    my ($nc,$name)=@_;
    return find_index_by_name($nc->{'vars'},$name);
}
sub nc_find_att_index
{
    my ($var,$name)=@_;
    return find_index_by_name($var->{'atts'},$name);
}

sub find_index_by_name
# helper routine for nc_find_*
{
    my ($lr,$name)=@_;
    my $index;
    for $index (0..$#$lr){
	  return $index if $$lr[$index]->{'name'} eq $name;	
    }
    return -1;
}
#========================================================
# Routines for deleting dims, vars, atts by name
#
# (NB if you delete dims but leave vars which still depend on them,
# then expect segfault when you try to write)
#
sub nc_del_dim
{
    my ($nc,$name)=@_;
    del_by_name($nc->{'dims'},$name);
}
sub nc_del_var
{
    my ($nc,$name)=@_;
    del_by_name($nc->{'vars'},$name);
}
sub nc_del_att
{
    my ($var,$name)=@_;
    del_by_name($var->{'atts'},$name);
}

sub del_by_name
# helper routine for nc_del_*
{
    my ($lr,$name)=@_;
    @$lr = grep {$_->{'name'} ne $name} @$lr;
}
#========================================================
# Routines for adding dims, vars, atts
#
sub nc_add_dim
{
    my ($nc,@dimlist)=@_;
    push (@{$nc->{'dims'}},@dimlist);
}

sub nc_add_var
{
    my ($nc,@varlist)=@_;
    push (@{$nc->{'vars'}},@varlist);
}

sub nc_add_att
{
    my ($var,@attlist)=@_;
    push (@{$var->{'atts'}},@attlist);
}

#========================================================
# Defines the data source for a variable to be written
# can be a variable from an open input NetCDF file or from a list
#
sub nc_var_setsource
{
    my ($v,$source,@args) = @_;

    my $io = $v->{'io'};
    $io->{'source'} = $source;

    if ($source eq 'file') {
	$io->{'in_ncid'} = $args[0];
	$io->{'in_varid'} = $args[1];
    }
    elsif ($source eq 'list') {
	$io->{'in_list'} = $args[0];
    }
    else {
	die "unrecognised source \"$source\" in nc_var_setsource";
    }
}

#========================================================
# nc_var_xferslab
#
#  Function for use either copying or reading a variable.  Call with a 
#  variable reference, and optionally a NetCDF file and variable ID for
#  the variable to be written to.  Returns a reference to list of values
#  in the slab.  (Return value can be ignored if only want to copy
#  data.)
#
sub nc_var_xferslab
{
    my ($v, $out_ncid, $out_varid) = @_;
    my ($io, $s, $dim, $start, $carry, @vals);

    $io = $v->{'io'};

    return undef if $io->{'eof'};

    @vals=();

    if ($io->{'source'} eq 'file') {
	$s=NetCDF::varget($io->{'in_ncid'},$io->{'in_varid'},
			  $io->{'start'},$io->{'count'},\@vals);
    }
    elsif ($io->{'source'} eq 'list') {

	@vals=@{$io->{'in_list'}}[$io->{'start_scalar'} ..
				   $io->{'start_scalar'}+$io->{'count_scalar'}-1];
    }

    if (defined $out_ncid and defined $out_varid) {
        $s=NetCDF::varput($out_ncid,$out_varid,
                          $io->{'start'},$io->{'count'},\@vals);
    }

    # increment start
    $start=$io->{'start'};
    for ($dim=$#$start-1, $carry=1;
         $carry;
         $dim--) {

        if ($dim<0) {
            $io->{'eof'} = 1;       
            last;
        }       
        $$start[$dim]++;
        $carry=($$start[$dim] == $ {$io->{'sizes'}}[$dim]);
        $$start[$dim]=0 if ($carry);
    }
    $io->{'start_scalar'} += $io->{'count_scalar'};

    return \@vals;
}

#========================================================
# Test if a variable is already fully read
#
sub nc_var_eof
{
    my $v=shift;
    return $v->{'io'}->{'eof'};
}

#========================================================
# Start reading var at the beginning
#
sub nc_var_rewind
{
    my $v=shift;
    my $start;
    my $io = $v->{'io'};
    for $start(@{$io->{'start'}}) {
        $start=0;
    }
    $io->{'start_scalar'}=0;
    $io->{'eof'}=0;
}

#========================================================
1;