view release on metacpan or  search on metacpan

script/hcgen  view on Meta::CPAN

warn("$dir: ", scalar(@files), " files\n") if $verbose;

@files = sort { $a->[0] <=> $b->[0] or $a->[1] <=> $b->[1] } @files;
@files = reverse(@files) if $reverse;

my $this = "";
my $cal;
my $needhdr = defined($title) ? $title ? 1 : -99 : 0;

my $data = "";

foreach ( @files ) {
    my ( $y, $m, $d, $file ) = @$_;
    if ( sprintf("%04d%02d", $y, $m) ne $this ) {
	if ( $cal ) {
	    $data .= "<div class='hc'>\n";
	    $data .= $cal->build_title($title_format) . "\n"
	      if $needhdr >= 0;
	    $needhdr++;
	    $data .= $cal->calendar_month;
	    $data .= "</div>\n";
	}
	$cal = HTML::Calendar::Monthly->new
	  ({ 'month' => $m, year => $y });
	$this = sprintf("%04d%02d", $y, $m);
    }
    $cal->add_link( $d, $linkpfx.$file );
}

if ( $cal ) {
    $data .= "<div class='hc'>\n";
    $data .= $cal->build_title . "\n" if $needhdr > 0;
    $data .= $cal->calendar_month;
    $data .= "</div>\n";
}

if ( $output ) {
    if ( update_if_needed($output, $data) ) {
	warn("$output: written\n");
    }
    else {
	warn("$output: not modified\n");
    }
}
else {
    print $data;
}
exit 0;

################ Subroutines ################

sub HTML::Calendar::Monthly::build_title {
    my ($self, $fmt) = @_;
    my $t = $title_format;
    $t =~ s/\%m/lc($self->month_name)/ge;
    $t =~ s/\%M/$self->month_name/ge;
    $t =~ s/\%y/$self->year/gie;
    return $t;
}

sub update_if_needed($$) {
    my ($fname, $new) = @_;

    # Do not overwrite unless modified.
    if ( -s $fname && -s _ == length($new) ) {
	local($/);
	my $hh = do { local *F; *F };
	my $old;
	open($hh, "<", $fname) && ($old = <$hh>) && close($hh);
	if ( $old eq $new ) {
	    return 0;
	}
    }

    open(my $fh, ">", $fname)
      or die("$fname (create): $!\n");
    print $fh $new;
    close($fh);
    1;
}

################ Subroutines ################

sub app_options {
    my $help = 0;		# handled locally
    my $ident = 0;		# handled locally
    my $man = 0;		# handled locally

    my $pod2usage = sub {
        # Load Pod::Usage only if needed.
        require Pod::Usage;
        Pod::Usage->import;
        &pod2usage;
    };

    # Process options.
    if ( @ARGV > 0 ) {
	GetOptions('output=s'	=> \$output,
		   'prefix=s'	=> \$linkpfx,
		   'reverse'	=> \$reverse,
		   'title!'	=> \$title,
		   'format=s'	=> \$title_format,
		   'force=s'	=> \@forced,
		   'filter=s'	=> \$filter,
		   'ident'	=> \$ident,
		   'verbose'	=> \$verbose,
		   'trace'	=> \$trace,
		   'help|?'	=> \$help,
		   'man'	=> \$man,
		   'debug'	=> \$debug)
	  or $pod2usage->(2);
    }
    if ( $ident or $help or $man ) {
	print STDERR ("This is $my_package [$my_name $my_version]\n");
    }
    if ( $man or $help ) {
	$pod2usage->(1) if $help;
	$pod2usage->(VERBOSE => 2) if $man;
    }
}