view release on metacpan or  search on metacpan

script/album  view on Meta::CPAN

    my $name;
    my $doing = 0;
    my $did = 0;

    while ( <DATA> ) {
        if ( $doing ) {         # uudecoding...
            if ( /^Xend/ ) {
                close($out);
                $doing = 0;	# Done
		next;
            }
            # Select lines to process.
            next if /[a-z]/;
	    next unless /^X(.*)/s;
	    $_ = $1;
            next unless int((((ord() - 32) & 077) + 2) / 3)
              == int(length() / 4);
            # Decode.
            print $out unpack("u",$_);
            next;
        }

        # Otherwise, search for the uudecode 'begin' line.
        if ( /^Xbegin\s+\d+\s+(.+)$/ ) {
	    next if !$clobber && -s d_icons($1);
	    print STDERR ("Creating icons: ") if $verbose > 1 && !defined($name);
	    $did++;
            $name = d_icons($1);
	    print STDERR ("$1 ") if $verbose > 1;
            open($out, ">$name");
	    binmode($out);
            $doing = 1;         # Doing
            next;
        }
    }
    print STDERR ("\n") if $verbose > 1;
    if ( $doing ) {
        die("Error in DATA: still processing $name\n");
        unlink($name);
    }
}

################ Style Sheets ################

my $add_stylesheet_msg;
sub add_stylesheets {
    my $css_fontfam = "font-family: Verdana, Arial, Helvetica";
    my $WHITE = "#FFFFFF";
    my $BLACK = "#000000";
    my $RED   = "#FF0000";
    my $LGREY = "#E0E0E0";
    my $MGREY = "#D0D0D0";
    my $DGREY = "#C0C0C0";

    $add_stylesheet_msg = 0;

    add_stylesheet("common", heredoc(<<"    EOD", 4));
    body {
	font-size:  80%; $css_fontfam;
	text: $BLACK;
	background: $DGREY;
    }
    td {
	font-size:  80%; $css_fontfam;
    }
    p.hdl, p.hdr {
	font-size: 140%; font-weight: bold;
	$css_fontfam;
    }
    p.ftl, p.ftr {
	font-size:  80%; $css_fontfam;
    }
    a:link {
	color: $BLACK; text-decoration: none;
    }
    a:visited {
	color: $BLACK; text-decoration: none;
    }
    a:active {
	color: $RED; text-decoration: none;
    }
    EOD

    add_stylesheet("index", heredoc(<<"    EOD", 4));
    \@import "common.css";
    a.info {
	position: relative; z-index: 24; background-color: $LGREY;
	color: $BLACK; text-decoration:none;
    }
    a.info:hover {
	z-index: 25; background-color: $LGREY;
    }
    a.info span {
	display: none;
    }
    a.info:hover span {
	display: block;
	position: absolute; top: 2em; left: 2em; width: 25em;
	border: 0px; background-color: $MGREY; color: $BLACK;
	text-align: center;
    }
    table.outer {
	background: #d0d0d0;
	border-collapse: separate;
	border-width: 2px;           /* border=2 */
	border-style: solid;
	border-color: #e8e8e8 #727272 #727272 #e8e8e8;
	border-spacing: 3px;        /* cellspacing = 3 */
    }
    table.outer tr {
	background: #e0e0e0;
    }
    table.outer td {
	border-width: 1px;
	border-style: solid;
	border-color: #7c7c7c #f5f5f5 #f5f5f5 #7c7c7c;
    }
    table.inner {
	border: outset 0px;
    }
    table.inner td {
	border: inset 0px;
    }
    p.hdr {
	font-size: 140%; font-weight: bold;
	font-family: Verdana, Arial, Helvetica;
    }
    p.hdr a:link {
	color: #000000; text-decoration: underline;
    }
    p.hdr a:visited {
	color: #000000; text-decoration: underline;
    }
    p.hdr a:hover {
	color: #FF0000; text-decoration: underline;
    }
    EOD

    add_stylesheet("large", heredoc(<<"    EOD", 4));
    \@import "common.css";
    a.info {
	position: relative; z-index: 24; background-color: $DGREY;
	color: $BLACK; text-decoration: none;
    }
    a.info:hover {
	z-index: 25; background-color: $DGREY;
    }
    a.info span {
	display: none;
    }
    a.info:hover span {
	display: block;
	position: absolute; top: 2em; left: 2em; width: 15em;
	border: 0px; background-color: $MGREY; color :$BLACK;
	text-align: center;
    }
    EOD

    add_stylesheet("medium", heredoc(<<"    EOD", 4));
    \@import "common.css";
    a.info {
	position: relative; z-index: 24; background-color: $DGREY;
	color:$BLACK; text-decoration:none;
    }
    a.info:hover {
	z-index: 25; background-color: $DGREY;
    }
    a.info span {
	display: none;
    }
    a.info:hover span {
	display: block;
	position: absolute; top:2em; left: 2em; width: 15em;
	border: 0px; background-color: $MGREY; color: $BLACK;
	text-align: center;
    }
    EOD

    add_stylesheet("journal", heredoc(<<"    EOD", 4));
    body {
	font-size: 100%; $css_fontfam;
	text: $BLACK;
	background: $WHITE;
    }
    p.hd {
	font-size: 140%; font-weight: bold;
	margin-left: 0.1in; margin-top: 0.1in; margin-bottom: 0.1in;
    }
    table.outer {
	width: 500px;
	border-spacing: 10px;
    }
    tr.grey {
	background: $DGREY;
    }
    table.outer td {
    }
    EOD

    print STDERR ("\n") if $add_stylesheet_msg;
}

sub add_stylesheet {
    my ($css, $data) = @_;
    return if -e d_css("$css.css");
    print STDERR ("Creating style sheets: ")
      unless $verbose <= 1 || $add_stylesheet_msg++;
    print STDERR ("$css.css ");
    $css = d_css("$css.css");
    open(my $out, ">".$css) or die("$css: $!\n");
    binmode($out);
    print {$out} ($data);
    close($out) or die("$css: $!\n");
}

################ End Style Sheets ################

sub detab {
    my ($line) = @_;
    my $orig = $line;
    my (@l) = split(/\t/, $line, -1);

    # Replace tabs with blanks, retaining layout

    $line = shift(@l);
    $line .= " " x (8-length($line)%8) . shift(@l) while @l;

    $line;
}

################ Copying: plain files ################

sub copy {
    my ($orig, $new, $time) = @_;

    $time = (stat($orig))[9] unless defined($time);

    my $in = do { local *F; *F };
    open($in, "<", $orig) or die("$orig: $!\n");
    binmode($in);

    my $out = do { local *F; *F };
    open($out, ">", $new) or die("$new: $!\n");
    binmode($out);

    my $buf;

    for (;;) {
	my ($r, $w, $t);
	defined($r = sysread($in, $buf, 10240))
	  or die("$orig: $!\n");
	last unless $r;
	for ( $w = 0; $w < $r; $w += $t ) {
	    $t = syswrite($out, $buf, $r - $w, $w)