/*------+---------+---------+---------+---------+---------+--------+*\
|                                                                    |
| Function:   toInt                                                  |
|    Input:   base to convert by (default is 10)                     |
|   Output:   int                                                    |
|  Purpose:   This function returns the integer value of the string. |
|             It can be used for binary, decimal, octal, and hex.    |
|                                                                    |
\*------+---------+---------+---------+---------+---------+--------+*/
int String::toInt(int base) {

    int intValue = 0;

    if (base != 2 && base != 8 && base != 10 && base != 16)
        return 0;

    if (base == 16)
        toUpper();

    for (int i = 0; i < length; i++) {

        intValue *= base;

        if(base == 16 && data[i] >= 'A' && data[i] <= 'F') {

            intValue += (data[i] - 'A' + 10);
        }
        else
            intValue += (data[i] - '0');
    }

    return intValue;
}




/*------+---------+---------+---------+---------+---------+--------+*\
|                                                                    |
| Function:   toFloat                                                |
|    Input:   void                                                   |
|   Output:   float                                                  |
|  Purpose:   This function returns to float value of the string.    |
|                                                                    |
\*------+---------+---------+---------+---------+---------+--------+*/
float String::toFloat() {

    //Local Variables
    int i = 0;
    float floatValueLeft = 0;
    float floatValueRight = 0;

    while (data[i] != '.' && data[i] != '\0') {

        floatValueLeft *= 10;
        floatValueLeft += (data[i] - '0');

        i++;
    }

    if (data[i] != '\0') {

        i = length - 1;

        while (data[i] != '.') {

            floatValueRight /= 10;
            floatValueRight += (data[i] - '0');

            i--;
        }
        floatValueRight /= 10;
    }

    return floatValueLeft + floatValueRight;
}

##</code><code>##

use Attribute::Handlers;

sub myfoo : attr {
    print Dumper \@_;
};


sub foo {
    print Dumper \@_;
}

##</code><code>##

sub new {
  my $class = shift;
  my $report = shift || "default";
  my $system = shift || "none";

  my $self = {
     logType   => "both",
     fileSize  => 100000000,
     fileExt   => ".log",
     filePath  => "/tmp/",
     fileCount => 3,
     dbAgeSize => 1,
     dbAgeUnit => "DAY",
     dbConnStr => 'dbi:mysql:reports:localhost',
     dbUser    => "scott",
     dbPasswd  => "tiger",
     status    => "testing",
     entry     => "",
     system    => $system,
     name      => $report,
  };

  $self->{fileName} = $self->{filePath} . $report . $log->{fileExt};

  return bless $self, $class;
}

##</code><code>##

#!/usr/bin/perl -w

use strict;
use MP3::Info;
use Getopt::Long;

use vars qw($tag $value);

my %value;
my $flag;
my @field = qw(title artist album year comment genre tracknum);
@value{@field} = ('') x @field;

GetOptions(map { $_.'=s',\$value{$_} } keys %value);

my $file = shift or USAGE() and exit;
my $tag  = get_mp3tag($file) or warn "no ID3 tag for '$file'";

for (keys %value) {
    next unless $value{$_};
    $tag->{uc $_} = $value{$_};
    $flag = 1;
}

set_mp3tag($file,$tag) if $flag;
write_tag($tag);

sub write_tag {
    my %tag = %{+shift};
    write while ($tag,$value) = each %tag;
}

sub USAGE {
    print "USAGE: $0 [options] file\noptions:\n";
    print map { "\t-$_\n" } @field;
}

format STDOUT =
   @<<<<<<<<<<  @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$tag,$value
.

__END__
=pod

=head1 NAME

id3_tweaker.pl - MP3::Info script

=head1 DESCRIPTION

This is a simple script that uses MP3::Info to alter the
a single ID3 tag fields or multiple ID3 tag fields. There
is no -help or -h option, just run the script by itself
for the USAGE.

=head1 SYNOPSIS

  for *nix:
    ./id3_tweaker.pl -year='1984' foo.mp3
  for win32:
    perl id3_tweaker.pl -year='1984' foo.mp3

  or run with the only argument being the file:
    ./id3_tweaker.pl foo.mp3

  retrieve list of tags that can be altered:
    ./id3_tweaker.pl

=cut


##</code><code>##

use strict;
use warnings;
use Data::Dumper;

my @array = (1..5, 8..10, 15..30, 35..40);
my @bucket;

my $j = 0;
for my $k (0 .. $#array) {
    if ($array[$k] == $array[$k+1] - 1) {
        push @{ $bucket[$j] }, $array[$k];
    }
    else {
        $j++;
    }
}

my @ip = (sort { $#$b <=> $#$a } @bucket)[0];
print Dumper \@ip;

##</code><code>##

package DMML;

use strict;
use warnings;
use DBI;
use Data::Dumper;

our (@FIELDS,$OUTPUT);

sub new {
	my $class = shift;
	my $self  = {};
	return bless $self, $class;
}

sub detail_report {
	my $self = shift;
	open DETAIL, '>', \$OUTPUT or die $!;

	return $self->write_report(format => 'DETAIL', @_);
}

sub summary_report {
	my $self = shift;
	open SUMMARY, '>', \$OUTPUT or die $!;

	return $self->write_report(format => 'DETAIL', @_);
}



sub write_report {
	my $self = shift;
	my %args = @_;

	$~ = $args{format};

	for (@{ $args{records} }) {
		@FIELDS = @$_;	
		write;
	}

	$~ = $args{format} . '_BOTTOM';
	@FIELDS = @{ $args{total} };
	write;

	return $OUTPUT;
}

format DETAIL_TOP =
 COUNT   #PAGES   FIRST     LAST      MEMBER#                 POSTAL ADDRESS                            PRODUCT    JOB#
------------------------------------------------------------------------------------------------------------------------
.
format DETAIL =
@>>>>>   @>>>>> @>>>>>>>> @>>>>>>>>  @>>>>>>>>  @>>>>>>>>>>>>>>>>>>>>>>>>> @>>>>>>>>>>>>>>>>>>>>>>>>>>  @>>>>>>  @>>>>>>
@FIELDS
.
format DETAIL_BOTTOM =
@>>>>>   @>>>>>
@FIELDS
.

format SUMMARY_TOP =
FormType                  #Kits     #Pages
------------------------------------------
.
format SUMMARY =
@<<<<<<<<<<<              @>>>>>    @>>>>>
@FIELDS
.
format SUMMARY_BOTTOM =
==========================================
@<<<<<<<<    @<<<<       @>>>>>>   @>>>>>>
@FIELDS
.

1;

##</code><code>##

use strict;
use warnings;
use DMML;
use Data::Dumper;

my $dmml = DMML->new;

my @field = (([1..9]) x 10);
my @total = (1,2);

my $output = $dmml->detail_report(
	records => \@field,
	total   => \@total,
);

print Dumper $dmml->{OUTPUT};

##</code><code>##

package DVD::director_movie;
use base qw(DVD::DBI);

__PACKAGE__->table('director_movie');
__PACKAGE__->columns(Primary => qw/movie director/);
__PACKAGE__->has_a(movie => 'DVD::movie');
__PACKAGE__->has_a(director => 'DVD::director');

__PACKAGE__->add_trigger(after_delete => sub {
        $_[0]->director->delete unless $_[0]->director->movies;
});

1;

##</code><code>##

use DBI;
use HTML::Template;

my $dbh = DBI->connect(...);
my $sth = $dbh->prepare('select id,title from movie');
$sth->execute;

my $movies   = $sth->fetchall_arrayref({});
my $template = HTML::Template->new(filehandle => \*DATA);

$template->param(movies => $movies);
print $template->output;

__DATA__
<form>
<select name="movies">
<tmpl_loop movies>
   <option value="<tmpl_var id>"><tmpl_var title></option>
</tmpl_loop>
</select>
</form>

##</code><code>##

use Carp;

sub AUTOLOAD {
    my ($self) = @_;
    $AUTOLOAD =~ /.*::(\w+)/ && exists $self->{$1} and return $self->{$1};
    croak "No such attribute: $1";
}

##</code><code>##

use strict;
use warnings;
use Data::Dumper;

my $str = 'foo=bar&baz=qux&one=1&two=2';
my %hash;
my @pair = split '&',$str;

for my $pair (@pair) {
   my ($key,$val) = split '=',$pair;
   $hash{$key} = $val;
}

print Dumper \%hash;

##</code><code>##

#!/usr/bin/perl

use strict;
use warnings;
use Time::Piece;
use HTML::Template;

my $time     = localtime;
my $curr_mon = $time->_mon;
my @month    = $time->mon_list;

my $tmpl = HTML::Template->new(filehandle => \*DATA);
$tmpl->param(month => [
	map {
		value => $_,
		label => $month[$_],
		curr  => $curr_mon == $_,
	}, 0..$#month
]);

print $tmpl->output;

__DATA__
<tmpl_loop month>
<select name="month">
	<option value="<tmpl_var value>" <tmpl_if curr>selected="1"</tmpl_if>>
		<tmpl_var label>
	</option>
</select>
</tmpl_loop>

##</code><code>##

#!/usr/bin/perl

use strict;
use warnings;
use Time::Piece;
use CGI qw(popup_menu);

my $time     = localtime;
my $curr_mon = $time->_mon;
my @month    = $time->mon_list;
my %label    = map {($month[$_] => $_)} 0..$#month;

print popup_menu(
	-name     => 'month',
	-values   => \@month,
	-default  => $month[$curr_mon],
	-labels   => \%label,
);


##</code><code>##

#!/usr/bin/perl

use strict;
use warnings;

our $var = 5;

increment_me($var) for 1..10;
decrement_me($var) for 1..5;
print_me($var);

sub increment_me {
	$var = shift;
	$var++;
}

sub decrement_me {
	$var = shift;
	$var--;
}

sub print_me {
	$var = shift;
	print "$var\n";
}

##</code><code>##

#!/usr/bin/perl

use strict;
use warnings;

my $var = My::Number->new;

$var->increment_me for 1..10;
$var->decrement_me for 1..5;
$var->print_me;


package My::Number;
sub new {
	my $class = shift;
	my $self  = { var => 0};
	return bless $self, $class;
}

sub increment_me {
	my $self = shift;
	$self->{var}++;
}

sub decrement_me {
	my $self = shift;
	$self->{var}--;
}

sub print_me {
	my $self = shift;
	print $self->{var},"\n";
}

##</code><code>##

#!/usr/bin/perl

use strict;
use warnings;

my $file   = shift;
my $chunk  = 2**22;  # two megs
my $total  = -s $file;
my $length = length(int($total/$chunk));

open IN, $file or die $!;
{
	local $/ = \$chunk;
	my $i    = 0;
	while (<IN>) {
		open OUT,'>',sprintf("%0".$length."d-%s",$i++,$file);
		print OUT;
	}
}

##</code><code>##

#!/usr/bin/perl

use strict;
use warnings;
use File::Find::Rule;

my $file  = 'bigfile.txt';
my @files = File::Find::Rule
	->file()
	->name( qr/^\d+-$file\Z/)
	->in( '.' )
;

open OUT, '>', "new_$file" or die $!;
for (sort @files) {
	open IN, $_;
	print OUT while <IN>;
}