JGirl.pm

package JGirl; # jgirl.com (after being liberated from domain squatters)
                                                              # 
use strict;                                                   # Oh, the irony!
use warnings;                                                #'
use base 'Squatting'; # <-----------------------------------'

use Encode;

our %CONFIG = (
  dbconnect => 'dbi:SQLite:dbname=jgirl.db',
  dbuser    => '',
  dbpass    => '',
  host_url  => 'http://ogle.myphotos.cc:4234',
  image_url => 'http://ogle.myphotos.cc/jds/var',
);

# Take utf8 encoded strings and turn them into Perl strings.
sub decoded_string {
  my ($x) = @_;
  $x = decode('utf8', $x);
  $x =~ s/&#(\d+);/chr($1)/ge;
  $x;
}

# Interpret incoming cgi vars as utf8 encoded strings.
sub decoded_input_from_utf8 {
  my $input = $_[0];
  for (keys %$input) {
    if (ref($input->{$_}) eq 'ARRAY') {
      $input->{$_} = [ map { decoded_string($_) } @{$input->{$_}} ];
    } else {
      $input->{$_} = decoded_string($input->{$_});
    } 
  }
}

# do this on every http request
sub service {
  my ($app, $c, @args) = @_;
  decoded_input_from_utf8($c->input);
  my $v = $c->v;
  $v->{title} = 'jGirlsNow';
  $app->next::method($c, @args);
}

package JGirl::DB;
use strict;
use warnings;
use DBI;
use Date::Calc qw(Add_Delta_Days);

sub dbh {
  DBI->connect(
    $JGirl::CONFIG{dbconnect}, $JGirl::CONFIG{dbuser}, $JGirl::CONFIG{dbpass},
    {
      AutoCommit => 1
    }
  );
}

sub today {
  my @x = localtime;
  sprintf('%d-%02d-%02d', $x[5]+1900, $x[4]+1, $x[3]);
}

sub one_day_back {
  my ($date) = @_; $date ||= today;
  my ($y, $m, $d) = Add_Delta_Days(split('-', $date), -1);
  sprintf('%d-%02d-%02d', $y, $m, $d);
}

sub upper_bound {
  my $n = shift || 7; $n--;
  my @x = localtime;
  my ($y, $m, $d) = Add_Delta_Days($x[5]+1900, $x[4]+1, $x[3], +$n);
  sprintf('%d-%02d-%02d', $y, $m, $d);
}

sub lower_bound {
  return our $lower_bound ||= do {
    my $dbh = dbh;
    my $sql = qq{
      SELECT date(created_on) as created_date
      FROM downloads
      ORDER BY id
      LIMIT 1
    };
    my $lowest = $dbh->selectall_arrayref($sql);
    if (@$lowest) {
      $lowest->[0][0];
    } else {
      '2008-01-01';
    }
  };
}

sub pictures_by_name {
  my ($names) = @_;
  my $dbh = dbh;
  my $names_like_this = join(" AND ", 
    map { "((p.name LIKE $_) OR (p.title LIKE $_))" } 
    map { $dbh->quote("%$_%") } @$names);
  my $sql = qq{
    SELECT p.id, s.name as site, p.name, p.title, p.filename
    FROM sites s JOIN pictures p ON p.site_id = s.id
    WHERE $names_like_this
    ORDER BY s.id, filename DESC
  };
  $dbh->selectall_arrayref($sql, { Slice => {} });
}

sub pictures_by_id {
  my ($ids) = @_;
  my @ids = sort @$ids;
  my $these_ids = join(", ", grep { /^\d+$/ } @ids);
  my $sql = qq{
    SELECT p.id, s.name as site, p.name, p.title, p.filename
    FROM sites s JOIN pictures p ON p.site_id = s.id
    WHERE p.id IN ($these_ids)
    ORDER BY s.id, filename DESC
  };
  my $dbh = dbh;
  $dbh->selectall_arrayref($sql, { Slice => {} });
}

sub logs {
  my ($pictures) = @_;
  my %logs;
  for (@$pictures) {
    my $download_id = $_->{download_id};
    my $site_name   = $_->{site};
    my $site_url    = $_->{url};
    my $download    = $logs{$download_id} ||= { 
      download_id => $download_id,
      sites       => {},
      urls        => {},
    };
    my $site = 
    $logs{$download_id}{sites}{$site_name} ||= [];
    $logs{$download_id}{urls}{ $site_name} ||= $site_url;
    push @$site, $_;
  }
  my @logs;
  for (reverse sort keys %logs) {
    push @logs, $logs{$_}
  }
  \@logs;
}

sub daily_logs {
  my ($date, $n) = @_;
  my $dbh = dbh;
  $date     ||= today;
  $n        ||= 7;
  my $lower_date = sprintf('%d-%02d-%02d', Add_Delta_Days(split('-', $date), -$n));
  my $q_date       = $dbh->quote($date);
  my $q_n          = $dbh->quote($n);
  my $q_lower_date = $dbh->quote($lower_date);
  my $sql_for_dls = qq{
    SELECT id, created_on, date(created_on) as created_date
    FROM downloads
    WHERE (date(created_on) <= $q_date) AND (date(created_on) > $q_lower_date)
    ORDER BY id DESC
    LIMIT $q_n
  };
  my $downloads = $dbh->selectall_arrayref($sql_for_dls, { Slice => {} });
  my $download_ids = join(', ', map { $_->{id} } @$downloads);
  $download_ids ||= '0';
  my $sql_for_pics = qq{
    SELECT p.id, s.name as site, s.url as url, p.name, p.title, p.filename, p.download_id, p.site_id
    FROM sites s JOIN pictures p ON p.site_id = s.id
    WHERE download_id IN ($download_ids)
    ORDER BY download_id, s.id, filename
  };
  my $pictures = $dbh->selectall_arrayref($sql_for_pics, { Slice => {} });
  my $logs = logs($pictures);
  my %created_on = map { 
    my $d = $_->{created_on}; $d =~ s/ .*$//; 
    $_->{id} => $d 
  } @$downloads;
  my @final_logs;
  my $current_date = $date;
  my $i = 0;
  while ($current_date gt $lower_date) {
    my $day = $logs->[$i];
    my $created_on = ($day && exists $created_on{$day->{download_id}})
      ? $created_on{$day->{download_id}}
      : "n/a" ;
    if ($created_on ne $current_date) {
      push @final_logs, { 
        created_on => $current_date,
        is_empty   => 1 
      };
    } else {
      $day->{created_on} = $created_on{$day->{download_id}};
      push @final_logs, $day;
      $i++;
    }
    $current_date = one_day_back($current_date);
  }
  \@final_logs;
}

package JGirl::Controllers;
use Squatting ':controllers';
use URI::Escape;
use Date::Calc qw(Add_Delta_Days);
use Data::Dump qw(pp);
use strict;
our @C = (
  C(
    Home => [ '/', '/jGirlsNow.(xml)' ],
    get => sub {
      my ($self, $xml) = @_;
      my $i    = $self->input;
      my $v    = $self->v;
      my $n    = $i->{n}    || 7;
      my $date = $i->{date} || '2008-11-17'; # JGirl::DB::today;
      my @date = split('-', $date);
      my $next = sprintf('%d-%02d-%02d', Add_Delta_Days(@date, +$n));
      my $prev = sprintf('%d-%02d-%02d', Add_Delta_Days(@date, -$n));
      # $next = undef if ($next ge JGirl::DB::today);
      $v->{logs}  = JGirl::DB::daily_logs($date => $n);
      $v->{focus} = 1;
      $v->{next}  = $next;
      $v->{prev}  = $prev;
      $v->{n}     = $n;
      if ($xml) {
        $self->render('home', 'atom');
      } else {
        $v->{upper_bound} = JGirl::DB::upper_bound($n);
        $v->{lower_bound} = JGirl::DB::lower_bound;
        $self->render('home');
      }
    }
  ),

  C(
    Day => [ '/(\d+)/(\d+)/(\d+)' ],
    get => sub {
      my ($self, $year, $month, $day) = @_;
      my $v = $self->v;
      my $date = sprintf('%d-%02d-%02d', $year, $month, $day);
      $v->{logs} = JGirl::DB::daily_logs($date => 1);
      $self->render('day');
    },
  ),

  C(
    Search => [ '/search' ],
    get => sub {
      my ($self) = @_;
      my $input = $self->input;
      my $q = uri_unescape($input->{q});
      $q =~ s/^\s*//;
      $q =~ s/\s*$//;
      my $names;
      if (ref($q)) {
        # ok - assign to $names
        $names = $q;
      } else {
        if ($q =~ /^\s*$/) {
          # bad - redirect home
          $self->redirect(R('Home'));
          return;
        } else {
          # ok - turn into arrayref w/ 1 item
          $names = [ $q ];
        }
      }
      my $v = $self->v;
      $v->{q} = $input->{q};
      $v->{pictures} = JGirl::DB::pictures_by_name($names);
      $v->{title} .= " - $input->{q}";
      $self->render('search');
    }
  ),

  C(
    Code => [ '/code' ],
    get => sub {
      my ($self) = @_;
      my $id = $self->input->{picture_id};
      my $ids;
      if (ref($id)) {
        $ids = $id;
      } else {
        if ((not defined($id)) || $id =~ /^\s*$/) {
          return $self->render('code_empty');
        } else {
          $ids = [ $id ];
        }
      }
      my %resize;
      $self->v->{pictures} = JGirl::DB::pictures_by_id($ids);
      $self->v->{resize}   = \%resize;
      for (@{ $self->v->{pictures} }) {
        $resize{$_->{site}} ||= [];
        my $file_number = $_->{filename};
        $file_number =~ s/\.\w+$//;
        push @{ $resize{$_->{site}} }, $file_number;
      }
      $self->render('code');
    },
  ),

  C(
    Env => [ '/env' ],
    get => sub {
      my ($self) = @_;
      $self->headers->{'Content-Type'} = 'text/plain';
      return pp($self->env);
    }
  ),
);

package JGirl::Views;
use Squatting ':views';
use HTML::AsSubs;
use XML::Atom::Feed;
use XML::Atom::Entry;
use Encode;
use strict;

sub span  { HTML::AsSubs::_elem('span',  @_) }
sub thead { HTML::AsSubs::_elem('thead', @_) }
sub tbody { HTML::AsSubs::_elem('tbody', @_) }
sub x     { map { HTML::Element->new('~literal', text => $_) } @_ }

# url for original image
sub url {
  "$JGirl::CONFIG{image_url}/$_[0]/$_[1]";
}

# url for medium image
sub medium_url {
  "$JGirl::CONFIG{image_url}/$_[0]/medium/$_[1]";
}

# return one random item from a list of items
sub random {
  $_[ int(rand(scalar(@_))) ]
}

# a pseudo-element for usage tips
sub tip {
  p({ class => 'tip' }, b("TIP: "), @_)
}
 
our %V;
our @V = (
  V(
    'html',

    layout => sub {
      my ($self, $v, $content) = @_;
      html(
        head(
          title($v->{title}),
          style(x($self->_css)),
          link({ rel => 'alternate', type => 'application/atom+xml', title => 'Atom', href => R('Home', 'xml') }),
        ),
        body(
          div({ id => 'container' },
            h1(a({ href => R('Home') }, 'jGirlsNow.com')),
            x($content),
          ),
        )
      )->as_HTML;
    },

    _css => sub {
      my ($self, $v) = @_;
      qq|
        body {
          font-family: "Trebuchet MS";
          font-size: 10pt;
        }
        table {
          font-size: 10pt;
        }
        input {
          font-size: 20pt;
          font-weight: bold;
        }
        h1 {
          margin: 8px 2px;
          font-size: 42pt;
          text-align: center;
        }
        h1 a {
          text-decoration: none;
        }
        a:hover {
          color: #fc2;
        }
        #container {
          /* width: 640px; */
        }
        #search {
          text-align: center;
        }
        #popular {
          position: fixed;
          top: 0;
          right: 1em;
          text-align: left;
        }
        #popular ul {
          margin: 0;
          padding: 0;
        }
        #popular li {
          list-style: none;
        }
        #info {
          font-size: 12pt;
          text-align: center;
        }
        #results {
          margin-top: 0.5em;
        }
        #code {
          margin-top: 1em;
        }
        #get-code {
          margin-top: 1em;
          text-align: center;
        }
        p.tip {
          margin: auto;
          width: 28em;
          height: 3.5em;
        }
        div.log h2 {
          font-family: Impact;
          font-size: 18pt;
          font-weight: normal;
        }
        div.log h3 {
          margin-left: 20px;
          font-family: Impact;
          font-size: 14pt;
          font-weight: normal;
        }
        div.log table {
          margin-left: 40px;
        }
        table.listing th {
          text-align: left;
          font-weight: bold;
        }
        div.pager ul {
          text-align: center;
        }
        div.pager ul li {
          display: inline;
        }
        div.pager ul li a {
          margin: 2px 40px;
          text-decoration: none;
        }
      |;
    },

    _search => sub {
      my ($self, $v) = @_;
      div({ id => 'search' },
        form(
          { id => 'search', action => R('Search'), method => 'get' },
          input({ type => 'text', id => 'q', name => 'q' }),
          input({ type => 'submit', value => 'Search' })
        ),
        random(
          tip("Typing your query in Japanese will often yield better results."),
          tip("Even if you can't type in Japanese, you should still be able to copy and paste Japanese characters into the search box."),
          tip("If the Japanese characters aren't showing up, you should consider installing some international fonts."),
        ),
        div({ id => 'popular' },
          h4("Popular Searches"),
          ul(
            li( a({ href => R('Search', { q => '渡辺万美' }) },   "Bambi Watanabe")),
            li( a({ href => R('Search', { q => '原幹恵' }) },     "Mikie Hara")),
            li( a({ href => R('Search', { q => '滝沢乃南' }) },   "Nonami Takizawa")),
            li( a({ href => R('Search', { q => '入江' }) },       "Saaya Irie")),
            li( a({ href => R('Search', { q => 'Tsugihara' }) },  "Kana Tsugihara")),
            li( a({ href => R('Search', { q => '佐藤和沙' }) },   "Kazusa Sato")),
          ),
          h4("Please visit my new site:"),
          ul(
            li( a({ href => 'http://scantilyclad.org/' }, "http://scantilyclad.org/" ) ),
          ),
          h4("Ads"),
          div(
            x(qq|
<script type="text/javascript"><!--
google_ad_client = "pub-3456598529176401";
/* 120x240, created 5/25/09 */
google_ad_slot = "1646079276";
google_ad_width = 120;
google_ad_height = 240;
//-->
</script>
<script type="text/javascript"
src="http://pagead2.googlesyndication.com/pagead/show_ads.js">
</script>
            |),
          ),
        ),
        do { 
          if ($v->{focus}) {
            script('document.getElementById("q").focus()')
          }
        },
      )->as_HTML;
    },

    _log_empty => sub {
      my ($self, $v) = @_;
      div({ class => 'log' },
        h2($v->{created_on}),
        p('No images today.')
      )->as_HTML;
    },

    _log => sub {
      my ($self, $v) = @_;
      my $day = $v;
      return $self->_log_empty($day) if ($day->{is_empty});
      div({ class => 'log', id => "log-$v->{download_id}" },
        h2(a({href=>R('Day', split('-', $v->{created_on}))}, $v->{created_on})),
        map {
          my $name = $_;
          my $pictures = $v->{sites}{$name};
          h3(a({href=>$v->{urls}{$name}}, $name)),
          table({ class => 'listing' },
            thead(
              th({ width => 160, align => 'left' }, 'filename'),
              th({ width => 340, align => 'left' }, 'name'),
              th({ align => 'left' }, 'title'),
            ),
            tbody(
              map {
                my $pic = $_;
                &tr(
                  td({ class => 'file'  }, a({ href => url($pic->{site}, $pic->{filename}) }, "$pic->{site}/$pic->{filename}") ),
                  td({ class => 'name'  }, a({ href => R('Search', { q => $pic->{name} }) }, decode('utf8', $pic->{name}) ) ),
                  td({ class => 'title' }, decode('utf8', $pic->{title}) ),
                )
              } @$pictures
            )
          )
        } (sort keys %{ $v->{sites} })
      )->as_HTML;
    },

    _logs => sub {
      my ($self, $v) = @_;
      div({ id => 'logs' },
        map { x($self->_log($_)) } @{ $v->{logs} }
      )->as_HTML;
    },

    _pager => sub {
      my ($self, $v) = @_;
      my $upper_bound = $v->{upper_bound};
      my $lower_bound = $v->{lower_bound};
      div({ class => 'pager' },
        ul(
          (($v->{next} le $upper_bound) 
            && li( a({ href=>R('Home', { date => $v->{next}, n => $v->{n} }) }, "< next ($v->{next})") )),
          (($v->{prev} ge $lower_bound) 
            && li( a({ href=>R('Home', { date => $v->{prev}, n => $v->{n} }) }, "($v->{prev}) prev >") )),
        ),
      )->as_HTML;
    },

    home => sub {
      my ($self, $v) = @_;
      div(
        x($self->_search($v)),
        x($self->_pager($v)),
        x($self->_logs($v)),
        x($self->_pager($v)),
      )->as_HTML;
    },

    day => sub {
      my ($self, $v) = @_;
      div(
        x($self->_search($v)),
        x($self->_logs($v)),
      )->as_HTML;
    },

    _results => sub {
      my ($self, $v) = @_;
      my @pictures = @{ $v->{pictures} };
      join( "", map {
        my $pic = $_;
        &tr(
          td( input({ type => 'checkbox', name => 'picture_id', value => $pic->{id} }) ),
          td({ class => 'file'  }, a({ href => url($pic->{site}, $pic->{filename}) }, "$pic->{site}/$pic->{filename}") ),
          td({ class => 'name'  }, decode('utf8', $pic->{name}) ),
          td({ class => 'title' }, decode('utf8', $pic->{title}) ),
        )->as_HTML
      } @pictures );
    },

    search => sub {
      my ($self, $v) = @_;
      div(
        x($self->_search),
        div({ id => 'info' }, 
          strong(scalar(@{ $v->{pictures} })), " results for: ", strong($v->{q}) ),
        div( { id => 'results' },
          form( { action => R('Code') },
            span("\n"),
            table({ id => 'results', class => 'listing' },
              thead(
                th(' '),
                th({ width => 160, align => 'left' }, 'filename'),
                th({ width => 340, align => 'left' }, 'name'),
                th({ align => 'left' }, 'title'),
              ),
              tbody( x($self->_results($v)) )
            ),
            div({ id => 'get-code' },
              input({type => 'submit', value => 'Get Code' }),
            ),
          ),
        ),
      )->as_HTML;
    },

    code => sub {
      my ($self, $v) = @_;
      my @pictures = @{ $v->{pictures} };
      my %resize   = %{ $v->{resize}   };
      div({ id => 'code' },
        h2('Resizing Commands'),
        pre({ id => 'resize' },
          join("\n", map {
            my $ids = join(' ', @{$resize{$_}});
            "cd $_\n".
            qq|for i in $ids ; do ls -l \$i.jpg ; convert -quality 70 -resize '640>' \$i.jpg medium/\$i.jpg ; ls -l medium/\$i.jpg ; done\n|.
            "cd ..\n";
          } grep { exists $resize{$_} } qw(white sakura red) )
        ),
        h2('HTML for Resized Images (With Links to Full-sized Images)'),
        pre({ id => 'html' },
          join("\n", map {
            my $pic = $_;
            a({ href => url($pic->{site}, $pic->{filename})},
              img({ src => medium_url($pic->{site}, $pic->{filename}) }),
            )->as_HTML;
          } @pictures )
        ),
        h2('HTML for Full-sized Images'),
        pre({ id => 'html' },
          join("\n", map {
            my $pic = $_;
            img({ src => url($pic->{site}, $pic->{filename}) })->as_HTML,
          } @pictures )
        ),
      )->as_HTML;
    },

    code_empty => sub {
      my ($self, $v) = @_;
      div({ id => 'code' },
        h2('You have to pick some pictures, first.'),
        p('Be sure to click on the checkboxes next to the images.'),
      )->as_HTML;
    },

  ),

  V(
    'atom',
    home => sub {
      my ($self, $v) = @_;
      $self->headers->{'Content-Type'} = 'application/atom+xml';

      my $feed = XML::Atom::Feed->new(Version => 1.0);
      $feed->title('jGirlsNow');
      $feed->id('tag:jGirlsNow.com:2008:home');

      my $link = XML::Atom::Link->new(Version => 1.0);
      $link->type('text/html');
      $link->rel('alternate');
      $link->href($JGirl::CONFIG{host_url}.R('Home'));
      $feed->add_link($link);

      for my $day (@{ $v->{logs} }) {
        next if $day->{is_empty};
        my $entry = XML::Atom::Entry->new(Version => 1.0);
        $entry->title($day->{created_on});
        $entry->id("tag:jGirlsNow.com:2008:$day->{download_id}");
        $entry->content($V{html}->_log($day));
        $entry->published($day->{created_on});

        my $link = XML::Atom::Link->new(Version => 1.0);
        $link->type('text/html');
        $link->rel('alternate');
        $link->href($JGirl::CONFIG{host_url}.R('Day', split('-', $day->{created_on})));
        $entry->add_link($link);
        $feed->add_entry($entry);
      }
      $feed->as_xml;
    },
  ),

);

1;